home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume3 / turbo_tools / part2 < prev    next >
Encoding:
Internet Message Format  |  1986-11-30  |  53.5 KB
  1. From: talcott!cmcl2!lanl!jp (James Potter)
  2. Subject: Software Tools in Turbo Pascal (Part 2 of 2)
  3. Newsgroups: mod.sources
  4. Approved: jpn@panda.UUCP
  5.  
  6. Mod.sources:  Volume 3, Issue 34
  7. Submitted by: talcott!cmcl2!lanl!jp (James Potter)
  8.  
  9.  
  10.  
  11. #! /bin/sh
  12. # This is a shell archive, meaning:
  13. # 1. Remove everything above the #! /bin/sh line.
  14. # 2. Save the resulting text in a file.
  15. # 3. Execute the file with /bin/sh (not csh) to create the files:
  16. #    chapter1.pas
  17. #    chapter2.pas
  18. #    chapter3.pas
  19. #    chapter4.pas
  20. #    chapter5.pas
  21. #    chapter6.pas
  22. # This archive created: Fri Nov  1 20:12:01 1985
  23. export PATH; PATH=/bin:$PATH
  24. echo shar: extracting "'chapter1.pas'" '(2054 characters)'
  25. if test -f 'chapter1.pas'
  26. then
  27.     echo shar: will not over-write existing file "'chapter1.pas'"
  28. else
  29. cat << \SHAR_EOF > 'chapter1.pas'
  30. {chapter1.pas}
  31.  
  32. {
  33.         Copyright (c) 1981
  34.         By:     Bell Telephone Laboratories, Inc. and
  35.                 Whitesmith's Ltd.,
  36.  
  37.         This software is derived from the book
  38.                 "Software Tools in Pascal", by
  39.                 Brian W. Kernighan and P. J. Plauger
  40.                 Addison-Wesley, 1981
  41.                 ISBN 0-201-10342-7
  42.  
  43.         Right is hereby granted to freely distribute or duplicate this
  44.         software, providing distribution or duplication is not for profit
  45.         or other commercial gain and that this copyright notice remains
  46.         intact.
  47. }
  48.  
  49. PROCEDURE COPY;
  50. VAR C:CHARACTER;
  51. BEGIN
  52.   WHILE(GETC(C)<>ENDFILE)DO
  53.     PUTC(C)
  54. END;
  55.  
  56.  
  57. PROCEDURE CHARCOUNT;
  58. VAR
  59.   NC:INTEGER;
  60.   C:CHARACTER;
  61. BEGIN
  62.   NC:=0;
  63.   WHILE (GETC(C)<>ENDFILE)DO
  64.      NC:=NC+1;
  65.   PUTDEC(NC,1);
  66.   PUTC(NEWLINE)
  67. END;
  68.  
  69. PROCEDURE LINECOUNT;
  70. VAR
  71.   N1:INTEGER;
  72.   C:CHARACTER;
  73. BEGIN
  74.   N1:=0;
  75.   WHILE(GETC(C)<>ENDFILE)DO
  76.     IF(C=NEWLINE)THEN
  77.       N1:=N1+1;
  78.   PUTDEC(N1,1);
  79.   PUTC(NEWLINE)
  80. END;
  81.  
  82. PROCEDURE WORDCOUNT;
  83. VAR
  84.   NW:INTEGER;
  85.   C:CHARACTER;
  86.   INWORD:BOOLEAN;
  87. BEGIN
  88.   NW:=0;
  89.   INWORD:=FALSE;
  90.   WHILE(GETC(C)<>ENDFILE)DO
  91.     IF(C=BLANK)OR(C=NEWLINE)OR(C=TAB) THEN
  92.       INWORD:=FALSE
  93.     ELSE IF (NOT INWORD)THEN BEGIN
  94.       INWORD:=TRUE;
  95.       NW:=NW+1
  96.     END;
  97.   PUTDEC(NW,1);
  98.   PUTC(NEWLINE)
  99. END;
  100.  
  101. PROCEDURE DETAB;
  102. CONST
  103.   MAXLINE=1000;
  104. TYPE
  105.   TABTYPE=ARRAY[1..MAXLINE] OF BOOLEAN;
  106. VAR
  107.   C:CHARACTER;
  108.   COL:INTEGER;
  109.   TABSTOPS:TABTYPE;
  110.  
  111. FUNCTION TABPOS(COL:INTEGER;VAR TABSTOPS:TABTYPE)
  112.   :BOOLEAN;
  113. BEGIN
  114.   IF(COL>MAXLINE)THEN
  115.     TABPOS:=TRUE
  116.   ELSE
  117.     TABPOS:=TABSTOPS[COL]
  118. END;
  119.  
  120. PROCEDURE SETTABS(VAR TABSTOPS:TABTYPE);
  121. CONST
  122.   TABSPACE=4;
  123. VAR
  124.   I:INTEGER;
  125. BEGIN
  126.   FOR I:=1 TO MAXLINE DO
  127.     TABSTOPS[I]:=(I MOD TABSPACE = 1)
  128. END;
  129.  
  130. BEGIN
  131.   SETTABS(TABSTOPS);
  132.   COL:=1;
  133.   WHILE(GETC(C)<>ENDFILE)DO
  134.     IF(C=TAB)THEN
  135.      REPEAT
  136.       PUTC(BLANK);
  137.       COL:=COL+1
  138.      UNTIL(TABPOS(COL,TABSTOPS))
  139.     ELSE IF(C=NEWLINE)THEN BEGIN
  140.       PUTC(NEWLINE);
  141.       COL:=1
  142.     END
  143.     ELSE BEGIN
  144.       PUTC(C);
  145.       COL:=COL+1
  146.     END
  147. END;
  148.  
  149.  
  150.  
  151.  
  152. SHAR_EOF
  153. if test 2054 -ne "`wc -c < 'chapter1.pas'`"
  154. then
  155.     echo shar: error transmitting "'chapter1.pas'" '(should have been 2054 characters)'
  156. fi
  157. fi # end of overwriting check
  158. echo shar: extracting "'chapter2.pas'" '(6124 characters)'
  159. if test -f 'chapter2.pas'
  160. then
  161.     echo shar: will not over-write existing file "'chapter2.pas'"
  162. else
  163. cat << \SHAR_EOF > 'chapter2.pas'
  164. {chapter2.pas}
  165.  
  166. {
  167.         Copyright (c) 1981
  168.         By:     Bell Telephone Laboratories, Inc. and
  169.                 Whitesmith's Ltd.,
  170.  
  171.         This software is derived from the book
  172.                 "Software Tools in Pascal", by
  173.                 Brian W. Kernighan and P. J. Plauger
  174.                 Addison-Wesley, 1981
  175.                 ISBN 0-201-10342-7
  176.  
  177.         Right is hereby granted to freely distribute or duplicate this
  178.         software, providing distribution or duplication is not for profit
  179.         or other commercial gain and that this copyright notice remains
  180.         intact.
  181. }
  182.  
  183. PROCEDURE TRANSLIT;FORWARD;
  184. PROCEDURE ENTAB;FORWARD;
  185. PROCEDURE EXPAND;FORWARD;
  186. PROCEDURE ECHO;FORWARD;
  187. PROCEDURE COMPRESS;FORWARD;
  188. PROCEDURE OVERSTRIKE;FORWARD;
  189.  
  190.  
  191. PROCEDURE OVERSTRIKE;
  192. CONST
  193.   SKIP=BLANK;
  194.   NOSKIP=PLUS;
  195. VAR
  196.   C:CHARACTER;
  197.   COL,NEWCOL,I:INTEGER;
  198. BEGIN
  199.   COL:=1;
  200.   REPEAT
  201.     NEWCOL:=COL;
  202.     WHILE(GETC(C)=BACKSPACE) DO
  203.       NEWCOL:=MAX(NEWCOL-1,1);
  204.     IF (NEWCOL<COL) THEN BEGIN
  205.       PUTC(NEWLINE);
  206.       PUTC(NOSKIP);
  207.       FOR I:=1 TO NEWCOL-1 DO
  208.         PUTC(BLANK);
  209.       COL:=NEWCOL
  210.     END
  211.     ELSE IF (COL=1) AND (C<>ENDFILE) THEN
  212.       PUTC(SKIP);
  213.     IF(C<>ENDFILE)THEN BEGIN
  214.       PUTC(C);
  215.       IF (C=NEWLINE) THEN
  216.         COL:=1
  217.       ELSE
  218.         COL:=COL+1
  219.       END
  220.     UNTIL (C=ENDFILE)
  221.   END;
  222.  
  223. PROCEDURE COMPRESS;
  224. CONST
  225.   WARNING=CARET;
  226. VAR
  227.   C,LASTC:CHARACTER;
  228.   N:INTEGER;
  229.  
  230. PROCEDURE PUTREP(N:INTEGER;C:CHARACTER);CONST
  231.   MAXREP=26;
  232.   THRESH=4;
  233. BEGIN
  234.   WHILE(N>=THRESH)OR((C=WARNING)AND(N>0))DO BEGIN
  235.     PUTC(WARNING);
  236.     PUTC(MIN(N,MAXREP)-1+ORD('A'));
  237.     PUTC(C);
  238.     N:=N-MAXREP
  239.   END;
  240.   FOR N:=N DOWNTO 1 DO
  241.     PUTC(C)
  242.   END;
  243.  
  244. BEGIN(*COMPRESS*)
  245.   N:=1;
  246.   LASTC:=GETC(LASTC);
  247.   WHILE(LASTC<>ENDFILE) DO BEGIN
  248.     IF(GETC(C)=ENDFILE)THEN BEGIN
  249.       IF(N>1) OR(LASTC=WARNING) THEN
  250.         PUTREP(N,LASTC)
  251.       ELSE
  252.         PUTC(LASTC)
  253.       END
  254.       ELSE IF (C=LASTC) THEN
  255.         N:=N+1
  256.       ELSE IF (N>1) OR (LASTC=WARNING) THEN BEGIN
  257.         PUTREP(N,LASTC);
  258.         N:=1
  259.       END
  260.       ELSE
  261.          PUTC(LASTC);
  262.       LASTC:=C
  263.     END
  264.   END;
  265.   
  266.   PROCEDURE EXPAND;
  267.   CONST
  268.     WARNING=CARET;
  269.    VAR
  270.      C:CHARACTER;
  271.      N:INTEGER;
  272.   BEGIN
  273.     WHILE(GETC(C)<>ENDFILE) DO
  274.       IF (C<>WARNING)THEN
  275.         PUTC(C)
  276.       ELSE IF(ISUPPER(GETC(C))) THEN BEGIN
  277.         N:=C-ORD('A')+1;
  278.         IF(GETC(C)<>ENDFILE)THEN
  279.           FOR N:=N DOWNTO 1 DO
  280.             PUTC(C)
  281.           ELSE BEGIN
  282.             PUTC(WARNING);
  283.             PUTC(N-1+ORD('A'))
  284.           END
  285.       END
  286.       ELSE BEGIN
  287.         PUTC(WARNING);
  288.         IF(C<>ENDFILE) THEN
  289.           PUTC(C)
  290.       END
  291.   END;
  292.  
  293.  
  294. PROCEDURE ECHO;
  295. VAR
  296.   I,J:INTEGER;
  297.   ARGSTR:XSTRING;
  298. BEGIN
  299.   I:=2;
  300.   WHILE(GETARG(I,ARGSTR,MAXSTR))DO BEGIN
  301.     IF(I>1) THEN PUTC(BLANK);
  302.     FOR J:=1 TO XLENGTH(ARGSTR) DO
  303.       PUTC(ARGSTR[J]);
  304.     I:=I+1
  305.   END;
  306.   IF(I>1)THEN PUTC(NEWLINE)
  307. END;
  308.  
  309.  
  310.  
  311. PROCEDURE ENTAB;
  312. CONST
  313.   MAXLINE=1000;
  314. TYPE
  315.   TABTYPE=ARRAY[1..MAXLINE] OF BOOLEAN;
  316. VAR
  317.   C:CHARACTER;
  318.   COL,NEWCOL:INTEGER;
  319.   TABSTOPS:TABTYPE;
  320.  
  321. FUNCTION TABPOS(COL:INTEGER;VAR TABSTOPS:TABTYPE):BOOLEAN;
  322. BEGIN
  323.   IF(COL>MAXLINE)THEN
  324.     TABPOS:=TRUE
  325.   ELSE
  326.     TABPOS:=TABSTOPS[COL]
  327. END;
  328.  
  329. PROCEDURE SETTABS(VAR TABSTOPS:TABTYPE);
  330. CONST
  331.   TABSPACE=4;
  332. VAR
  333.   I:INTEGER;
  334. BEGIN
  335.   FOR I:=1 TO MAXLINE DO
  336.     TABSTOPS[I]:=(I MOD TABSPACE = 1)
  337. END;
  338.  
  339.     BEGIN
  340.   SETTABS(TABSTOPS);
  341.   COL:=1;
  342.   REPEAT
  343.     NEWCOL:=COL;
  344.     WHILE(GETC(C)=BLANK) DO BEGIN
  345.       NEWCOL:=NEWCOL+1;
  346.       IF(TABPOS(NEWCOL,TABSTOPS))THEN BEGIN
  347.         PUTC(TAB);
  348.         COL:=NEWCOL;
  349.       END
  350.     END;
  351.     WHILE (COL<NEWCOL) DO BEGIN
  352.       PUTC(BLANK);
  353.       COL:=COL+1
  354.     END;
  355.     IF(C<>ENDFILE) THEN BEGIN
  356.       PUTC(C);
  357.       IF(C=NEWLINE) THEN
  358.         COL:=1
  359.       ELSE
  360.         COL:=COL+1
  361.       END
  362.     UNTIL(C=ENDFILE)
  363.   END;
  364.  
  365.  
  366.  
  367. PROCEDURE TRANSLIT;
  368. CONST
  369.   NEGATE=CARET;
  370. VAR
  371.   ARG,FROMSET,TOSET:XSTRING;
  372.   C:CHARACTER;
  373.   I,LASTTO:0..MAXSTR;
  374.   ALLBUT,SQUASH:BOOLEAN;
  375. FUNCTION XINDEX(VAR INSET:XSTRING;C:CHARACTER;
  376.   ALLBUT:BOOLEAN;LASTTO:INTEGER):INTEGER;
  377. BEGIN
  378.   IF(C=ENDFILE)THEN XINDEX:=0
  379.   ELSE IF (NOT ALLBUT) THEN
  380.     XINDEX:=INDEX(INSET,C)
  381.   ELSE IF(INDEX(INSET,C)>0)THEN
  382.     XINDEX:=0
  383.   ELSE
  384.     XINDEX:=LASTTO+1
  385. END;
  386.   
  387. FUNCTION MAKESET(VAR INSET:XSTRING;K:INTEGER;
  388.   VAR OUTSET:XSTRING;MAXSET:INTEGER):BOOLEAN;
  389.  
  390. VAR J:INTEGER;
  391.  
  392. PROCEDURE DODASH(DELIM:CHARACTER;VAR SRC:XSTRING;
  393.   VAR I:INTEGER;VAR DEST:XSTRING;
  394.   VAR J:INTEGER;MAXSET:INTEGER);
  395. VAR
  396.   K:INTEGER;
  397.   JUNK:BOOLEAN;
  398. BEGIN
  399.   WHILE (SRC[I]<>DELIM)AND(SRC[I]<>ENDSTR)DO BEGIN
  400.     IF(SRC[I]=ATSIGN)THEN
  401.       JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
  402.     ELSE IF (SRC[I]<>DASH) THEN
  403.       JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
  404.     ELSE IF (J<=1)OR(SRC[I+1]=ENDSTR)THEN
  405.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
  406.     ELSE IF (ISALPHANUM(SRC[I-1]))
  407.       AND (ISALPHANUM(SRC[I+1]))
  408.       AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
  409.         FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
  410.           JUNK:=ADDSTR(K,DEST,J,MAXSET);
  411.         I:=I+1
  412.       END
  413.     ELSE
  414.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
  415.     I:=I+1
  416.   END
  417.   
  418. END;(*DODASH*)
  419.  
  420. BEGIN(*MAKESET*)
  421.   J:=1;
  422.   DODASH(ENDSTR,INSET,K,OUTSET,J,MAXSET);
  423.   MAKESET:=ADDSTR(ENDSTR,OUTSET,J,MAXSET)
  424. END;(*MAKESET*)
  425.  
  426. BEGIN(*TRANSLIT*)
  427.   IF (NOT GETARG(2,ARG,MAXSTR))THEN
  428.     ERROR('USAGE:TRANSLIT FROM TO');
  429.   ALLBUT:=(ARG[1]=NEGATE);
  430.   IF(ALLBUT)THEN
  431.     I:=2
  432.   ELSE
  433.     I:=1;
  434.   IF (NOT MAKESET(ARG,I,FROMSET,MAXSTR)) THEN
  435.     ERROR('TRANSLIT:"FROM"SET TOO LARGE');
  436.   IF(NOT GETARG(3,ARG,MAXSTR))THEN
  437.     TOSET[1]:=ENDSTR
  438.   ELSE IF (NOT MAKESET(ARG,1,TOSET,MAXSTR)) THEN
  439.     ERROR('TRANSLIT:"TO"SET TOO LARGE')
  440.   ELSE IF (XLENGTH(FROMSET)<XLENGTH(TOSET))THEN
  441.     ERROR('TRANSLIT:"FROM"SHORTER THAN "TO');
  442.   
  443.   LASTTO:=XLENGTH(TOSET);
  444.   SQUASH:=(XLENGTH(FROMSET)>LASTTO) OR (ALLBUT);
  445.   REPEAT
  446.     I:=XINDEX(FROMSET,GETC(C),ALLBUT,LASTTO);
  447.     IF (SQUASH) AND(I>=LASTTO) AND (LASTTO>0) THEN BEGIN
  448.       PUTC(TOSET[LASTTO]);
  449.       REPEAT
  450.         I:=XINDEX(FROMSET,GETC(C),ALLBUT,LASTTO)
  451.       UNTIL (I<LASTTO)
  452.     END;
  453.     IF(C<>ENDFILE) THEN BEGIN
  454.       IF(I>0)AND(LASTTO>0) THEN
  455.         PUTC(TOSET[I])
  456.       ELSE IF (I=0)THEN
  457.         PUTC(C)
  458.       (*ELSE DELETE*)
  459.     END
  460.   UNTIL(C=ENDFILE)
  461. END;
  462.  
  463.  
  464.  
  465.  
  466. SHAR_EOF
  467. if test 6124 -ne "`wc -c < 'chapter2.pas'`"
  468. then
  469.     echo shar: error transmitting "'chapter2.pas'" '(should have been 6124 characters)'
  470. fi
  471. fi # end of overwriting check
  472. echo shar: extracting "'chapter3.pas'" '(11306 characters)'
  473. if test -f 'chapter3.pas'
  474. then
  475.     echo shar: will not over-write existing file "'chapter3.pas'"
  476. else
  477. cat << \SHAR_EOF > 'chapter3.pas'
  478. {chapter3.pas}
  479.  
  480. {
  481.         Copyright (c) 1981
  482.         By:     Bell Telephone Laboratories, Inc. and
  483.                 Whitesmith's Ltd.,
  484.  
  485.         This software is derived from the book
  486.                 "Software Tools in Pascal", by
  487.                 Brian W. Kernighan and P. J. Plauger
  488.                 Addison-Wesley, 1981
  489.                 ISBN 0-201-10342-7
  490.  
  491.         Right is hereby granted to freely distribute or duplicate this
  492.         software, providing distribution or duplication is not for profit
  493.         or other commercial gain and that this copyright notice remains
  494.         intact.
  495. }
  496.  
  497. PROCEDURE COMPARE;FORWARD;
  498. PROCEDURE INCLUDE;FORWARD;
  499. PROCEDURE CONCAT;FORWARD;
  500.  
  501. PROCEDURE MAKECOPY;
  502. VAR
  503.   INNAME,OUTNAME:XSTRING;
  504.   FIN,FOUT:FILEDESC;
  505. BEGIN
  506.   IF(NOT GETARG(2,INNAME,MAXSTR))
  507.     OR (NOT GETARG(3,OUTNAME,MAXSTR))THEN
  508.       ERROR('USAGE:MAKECOPY OLD NEW');
  509.   FIN:=MUSTOPEN(INNAME,IOREAD);
  510.   FOUT:=MUSTCREATE(OUTNAME,IOWRITE);
  511.   FCOPY(FIN,FOUT);
  512.   XCLOSE(FIN);
  513.   XCLOSE(FOUT)
  514. END;
  515.  
  516. PROCEDURE PRINT;
  517. VAR
  518.   NAME:XSTRING;
  519.   NULL:XSTRING;
  520.   I:INTEGER;
  521.   FIN:FILEDESC;
  522.   JUNK:BOOLEAN;
  523.  
  524. PROCEDURE FPRINT(VAR NAME:XSTRING;FIN:FILEDESC);
  525. CONST
  526.   MARGIN1=2;
  527.   MARGIN2=2;
  528.   BOTTOM=64;
  529.   PAGELEN=66;
  530. VAR
  531.   LINE:XSTRING;
  532.   LINENO,PAGENO:INTEGER;
  533.  
  534. PROCEDURE SKIP(N:INTEGER);
  535. VAR
  536.   I:INTEGER;
  537. BEGIN
  538.   FOR I:=1 TO N DO
  539.     PUTC(NEWLINE)
  540. END;
  541.  
  542. PROCEDURE HEAD(VAR NAME:XSTRING;PAGENO:INTEGER);
  543. VAR
  544.   PAGE:XSTRING;
  545. BEGIN
  546.   PAGE[1]:=ORD(' ');
  547.   PAGE[2]:=ORD('P');
  548.   PAGE[3]:=ORD('a');
  549.   PAGE[4]:=ORD('g');
  550.   PAGE[5]:=ORD('e');
  551.   PAGE[6]:=ORD(' ');
  552.   PAGE[7]:=ENDSTR;
  553.   PUTSTR(NAME,STDOUT);
  554.   PUTSTR(PAGE,STDOUT);
  555.   PUTDEC(PAGENO,1);
  556.   PUTC(NEWLINE)
  557. END;
  558.  
  559. BEGIN(*FPRINT*)
  560.   PAGENO:=1;
  561.   SKIP(MARGIN1);
  562.   HEAD(NAME,PAGENO);
  563.   SKIP(MARGIN2);
  564.   LINENO:=MARGIN1+MARGIN2+1;
  565.   WHILE(GETLINE(LINE,FIN,MAXSTR))DO BEGIN
  566.     IF(LINENO=0)THEN BEGIN
  567.       SKIP(MARGIN1);;
  568.       PAGENO:=PAGENO+1;
  569.       HEAD(NAME,PAGENO);
  570.       SKIP(MARGIN2);
  571.       LINENO:=MARGIN1+MARGIN2+1
  572.     END;
  573.     PUTSTR(LINE,STDOUT);
  574.     LINENO:=LINENO+1;
  575.     IF(LINENO>=BOTTOM)THEN BEGIN
  576.       SKIP(PAGELEN-LINENO);
  577.       LINENO:=0
  578.     END
  579.   END;
  580.   IF(LINENO>0)THEN
  581.     SKIP(PAGELEN-LINENO)
  582. END;
  583.   
  584. BEGIN(*PRINT*)
  585.   NULL[1]:=ENDSTR;
  586.   IF(NARGS=1)THEN
  587.     FPRINT(NULL,STDIN)
  588.   ELSE
  589.     FOR I:=2 TO NARGS DO BEGIN
  590.       JUNK:=GETARG(I,NAME,MAXSTR);
  591.       FIN:=MUSTOPEN(NAME,IOREAD);
  592.       FPRINT(NAME,FIN);
  593.       XCLOSE(FIN)
  594.     END
  595. END;
  596.  
  597. PROCEDURE COMPARE;
  598. VAR
  599.   LINE1,LINE2:XSTRING;
  600.   ARG1,ARG2:XSTRING;
  601.   LINENO:INTEGER;
  602.   INFILE1,INFILE2:FILEDESC;
  603.   F1,F2:BOOLEAN;
  604.   
  605. PROCEDURE DIFFMSG (N:INTEGER; VAR LINE1,LINE2:XSTRING);
  606. BEGIN
  607.   PUTDEC(N,1);
  608.   PUTC(COLON);
  609.   PUTC(NEWLINE);
  610.   PUTSTR(LINE1,STDOUT);
  611.   PUTSTR(LINE2,STDOUT)
  612. END;
  613.  
  614. BEGIN(*COMPARE*)
  615.   IF (NOT GETARG(2,ARG1,MAXSTR))
  616.    OR (NOT GETARG(3,ARG2,MAXSTR)) THEN
  617.      ERROR('USAGE:COMPARE FILE1 FILE2');
  618.   INFILE1:=MUSTOPEN(ARG1,IOREAD);
  619.   INFILE2:=MUSTOPEN(ARG2,IOREAD);
  620.   LINENO:=0;
  621.   REPEAT
  622.     LINENO:=LINENO+1;
  623.     F1:=GETLINE(LINE1,INFILE1,MAXSTR);
  624.     F2:=GETLINE(LINE2,INFILE2,MAXSTR);
  625.     IF (F1 AND F2) THEN
  626.       IF (NOT EQUAL(LINE1,LINE2)) THEN
  627.         DIFFMSG(LINENO,LINE1,LINE2)
  628.   UNTIL (F1=FALSE) OR (F2=FALSE);
  629.   IF(F2 AND NOT F1) THEN
  630.   WRITELN('COMPARE:END OF FILE ON FILE 1')
  631.   ELSE IF (F1 AND NOT F2) THEN
  632.     WRITELN('COMPARE:END OF FILE ON FILE2')
  633. END;
  634.  
  635.  
  636. PROCEDURE INCLUDE;
  637. VAR
  638.   INCL:XSTRING;
  639.  
  640. PROCEDURE FINCLUDE(F:FILEDESC);
  641. VAR
  642.   LINE,STR:XSTRING;
  643.   LOC,I:INTEGER;
  644.   F1:FILEDESC;
  645. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
  646.   VAR OUT:XSTRING):INTEGER;
  647.  
  648. VAR
  649.   J:INTEGER;
  650. BEGIN
  651.   WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
  652.     I:=I+1;
  653.   J:=1;
  654.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  655.     OUT[J]:=S[I];
  656.     I:=I+1;
  657.     J:=J+1
  658.   END;
  659.   OUT[J]:=ENDSTR;
  660.   IF(S[I]=ENDSTR) THEN
  661.     GETWORD:=0
  662.   ELSE
  663.     GETWORD:=I
  664. END;
  665.  
  666. BEGIN
  667.   WHILE (GETLINE(LINE,F,MAXSTR))DO BEGIN
  668.     LOC:=GETWORD(LINE,1,STR);
  669.     IF (NOT EQUAL(STR,INCL)) THEN
  670.       PUTSTR(LINE,STDOUT)
  671.     ELSE BEGIN
  672.       LOC:=GETWORD(LINE,LOC,STR);
  673.       STR[XLENGTH(STR)]:=ENDSTR;
  674.       FOR I:= 1 TO XLENGTH(STR)DO
  675.         STR[I]:=STR[I+1];
  676.       F1:=MUSTOPEN(STR,IOREAD);
  677.       FINCLUDE(F1);
  678.       XCLOSE(F1)
  679.     END
  680.   END
  681. END;
  682.  
  683. BEGIN
  684.   INCL[1]:=ORD('#');
  685.   INCL[2]:=ORD('i');
  686.   INCL[3]:=ORD('n');
  687.   INCL[4]:=ORD('c');
  688.   INCL[5]:=ORD('l');
  689.   INCL[6]:=ORD('u');
  690.   INCL[7]:=ORD('d');
  691.   INCL[8]:=ORD('e');
  692.   INCL[9]:=ENDSTR;
  693.   FINCLUDE(STDIN)
  694. END;
  695.   
  696. PROCEDURE CONCAT;
  697. VAR
  698.   I:INTEGER;
  699.   JUNK:BOOLEAN;
  700.   FD:FILEDESC;
  701.   S:XSTRING;
  702. BEGIN
  703.   FOR I:=2 TO NARGS DO BEGIN
  704.     JUNK:=GETARG(I,S,MAXSTR);
  705.     FD:=MUSTOPEN(S,IOREAD);
  706.     FCOPY(FD,STDOUT);
  707.     XCLOSE(FD)
  708.   END
  709. END;
  710.  
  711. PROCEDURE ARCHIVE;
  712. CONST
  713.   MAXFILES=10;
  714. VAR
  715.   ANAME:XSTRING;
  716.   CMD:XSTRING;
  717.   FNAME:ARRAY[1..MAXFILES]OF XSTRING;
  718.   FSTAT:ARRAY[1..MAXFILES] OF BOOLEAN;
  719.   NFILES:INTEGER;
  720.   ERRCOUNT:INTEGER;
  721.   ARCHTEMP:XSTRING;
  722.   ARCHHDR:XSTRING;
  723. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT:XSTRING):INTEGER;
  724. VAR
  725.   J:INTEGER;
  726. BEGIN
  727.   WHILE (S[I] IN [BLANK,TAB,NEWLINE]) DO
  728.     I:=I+1;
  729.   J:=1;
  730.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  731.     OUT[J]:=S[I];
  732.     I:=I+1;
  733.     J:=J+1
  734.   END;
  735.   OUT[J]:=ENDSTR;
  736.   IF(S[I]=ENDSTR) THEN
  737.     GETWORD:=0
  738.   ELSE
  739.     GETWORD:=I
  740. END;
  741.  
  742.  
  743. FUNCTION GETHDR(FD:FILEDESC;VAR BUF,NAME:XSTRING;
  744.   VAR SIZE:INTEGER):BOOLEAN;
  745. VAR
  746.   TEMP:XSTRING;
  747.   I:INTEGER;
  748. BEGIN
  749.   IF(GETLINE(BUF,FD,MAXSTR)=FALSE)THEN
  750.     GETHDR:=FALSE
  751.   ELSE BEGIN
  752.     I:=GETWORD(BUF,1,TEMP);
  753.     IF(NOT EQUAL(TEMP,ARCHHDR))THEN
  754.       ERROR('ARCHIVE NOT IN PROPER FORMAT');
  755.     I:=GETWORD(BUF,I,NAME);
  756.     SIZE:=CTOI(BUF,I);
  757.     GETHDR:=TRUE
  758.   END
  759. END;
  760.  
  761. FUNCTION FILEARG (VAR NAME:XSTRING):BOOLEAN;
  762. VAR
  763.   I:INTEGER;
  764.   FOUND:BOOLEAN;
  765. BEGIN
  766.   IF(NFILES<=0)THEN
  767.     FILEARG:=TRUE
  768.   ELSE BEGIN
  769.     FOUND:=FALSE;
  770.     I:=1;
  771.     WHILE(NOT FOUND) AND (I<=NFILES)DO BEGIN
  772.       IF(EQUAL(NAME,FNAME[I])) THEN BEGIN
  773.         FSTAT[I]:=TRUE;
  774.         FOUND:=TRUE
  775.       END;
  776.       I:=I+1
  777.     END;
  778.     FILEARG:=FOUND
  779.   END
  780. END;
  781.  
  782. PROCEDURE FSKIP(FD:FILEDESC;N:INTEGER);
  783. VAR
  784.   C:CHARACTER;
  785.   I:INTEGER;
  786. BEGIN
  787.   FOR I:=1 TO N DO
  788.     IF(GETCF(C,FD)=ENDFILE)THEN
  789.       ERROR('ARCHIVE:END OF FILE IN FSKIP')
  790. END;
  791.  
  792. PROCEDURE FMOVE(VAR NAME1,NAME2:XSTRING);
  793. VAR
  794.   FD1,FD2:FILEDESC;
  795. BEGIN
  796.   FD1:=MUSTOPEN(NAME1,IOREAD);
  797.   FD2:=MUSTCREATE(NAME2,IOWRITE);
  798.   FCOPY(FD1,FD2);
  799.   XCLOSE(FD1);
  800.   XCLOSE(FD2)
  801. END;
  802.  
  803.  
  804. PROCEDURE ACOPY(FDI,FDO:FILEDESC;N:INTEGER);
  805. VAR
  806.   C:CHARACTER;
  807.   I:INTEGER;
  808. BEGIN
  809.   FOR I:=1 TO N DO
  810.     IF (GETCF(C,FDI)=ENDFILE)THEN
  811.       ERROR('ARCHIVE: END OF FILE IN ACOPY')
  812.     ELSE
  813.       PUTCF(C,FDO)
  814. END;
  815.  
  816. PROCEDURE NOTFOUND;
  817. VAR
  818.   I:INTEGER;
  819. BEGIN
  820.   FOR I := 1 TO NFILES DO
  821.     IF(FSTAT[I]=FALSE)THEN BEGIN
  822.       PUTSTR(FNAME[I],STDERR);
  823.       WRITELN(':NOT IN ARCHIVE');
  824.       ERRCOUNT:=ERRCOUNT + 1
  825.     END
  826. END;
  827.  
  828. PROCEDURE ADDFILE(VAR NAME:XSTRING;FD:FILEDESC);
  829. VAR
  830.   HEAD:XSTRING;
  831.   NFD:FILEDESC;
  832. PROCEDURE MAKEHDR(VAR NAME,HEAD:XSTRING);
  833. VAR
  834.   I:INTEGER;
  835. FUNCTION FSIZE(VAR NAME:XSTRING):INTEGER;
  836. VAR
  837.   C:CHARACTER;
  838.   FD:FILEDESC;
  839.   N:INTEGER;
  840. BEGIN
  841.   N:=0;
  842.   FD:=MUSTOPEN(NAME,IOREAD);
  843.   WHILE(GETCF(C,FD)<>ENDFILE)DO
  844.     N:=N+1;
  845.   XCLOSE(FD);
  846.   FSIZE:=N
  847. END;
  848.  
  849. BEGIN
  850.   SCOPY(ARCHHDR,1,HEAD,1);
  851.   I:=XLENGTH(HEAD)+1;
  852.   HEAD[I]:=BLANK;
  853.   SCOPY(NAME,1,HEAD,I+1);
  854.   I:=XLENGTH(HEAD)+1;
  855.   HEAD[I]:=BLANK;
  856.   I:=ITOC(FSIZE(NAME),HEAD,I+1);
  857.   HEAD[I]:=NEWLINE;
  858.   HEAD[I+1]:=ENDSTR
  859. END;
  860.  
  861. BEGIN
  862.   NFD:=OPEN(NAME,IOREAD);
  863.   IF(NFD=IOERROR)THEN BEGIN
  864.     PUTSTR(NAME,STDERR);
  865.     WRITELN(':CAN''T ADD');
  866.     ERRCOUNT:=ERRCOUNT+1
  867.   END;
  868.   IF(ERRCOUNT=0)THEN BEGIN
  869.     MAKEHDR(NAME,HEAD);
  870.     PUTSTR(HEAD,FD);
  871.     FCOPY(NFD,FD);
  872.     XCLOSE(NFD)
  873.   END
  874. END;
  875.  
  876.  
  877. PROCEDURE REPLACE(AFD,TFD:FILEDESC;CMD:INTEGER);
  878. VAR
  879.   PINLINE,UNAME:XSTRING;
  880.   SIZE:INTEGER;
  881. BEGIN
  882.   WHILE(GETHDR(AFD,PINLINE,UNAME,SIZE))DO
  883.     IF(FILEARG(UNAME))THEN BEGIN
  884.       IF(CMD=ORD('U'))THEN
  885.         ADDFILE(UNAME,TFD);
  886.       FSKIP(AFD,SIZE)
  887.     END
  888.     ELSE BEGIN
  889.       PUTSTR(PINLINE,TFD);
  890.       ACOPY(AFD,TFD,SIZE)
  891.     END
  892. END;
  893.  
  894. PROCEDURE HELP;
  895. BEGIN
  896.   ERROR('USAGE:ARCHIVE -[CDPTUX] ARCHNAME [FILES...]')
  897. END;
  898.  
  899.  
  900. PROCEDURE GETFNS;
  901. VAR
  902.   I,J:INTEGER;
  903.   JUNK:BOOLEAN;
  904. BEGIN
  905.   ERRCOUNT:=0;
  906.   NFILES:=NARGS-3;
  907.   IF(NFILES>MAXFILES)THEN
  908.     ERROR('ARCHIVE:TO MANY FILE NAMES');
  909.   FOR I:=1 TO NFILES DO
  910.     JUNK:=GETARG(I+3,FNAME[I],MAXSTR);
  911.   FOR I:=1 TO NFILES DO
  912.    FSTAT[I]:=FALSE;
  913.   FOR I:=1 TO NFILES-1 DO
  914.     FOR J:=I+1 TO NFILES DO
  915.       IF(EQUAL(FNAME[I],FNAME[J]))THEN BEGIN
  916.         PUTSTR(FNAME[I],STDERR);
  917.         ERROR(':DUPLICATE FILENAME')
  918.       END
  919. END;
  920.  
  921.  
  922. PROCEDURE UPDATE(VAR ANAME:XSTRING;CMD:CHARACTER);
  923. VAR
  924.   I:INTEGER;
  925.   AFD,TFD:FILEDESC;
  926. BEGIN
  927.   TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  928.   IF(CMD=ORD('u')) THEN BEGIN
  929.    AFD:=MUSTOPEN(ANAME,IOREAD);
  930.    REPLACE(AFD,TFD,ORD('u'));(*UPDATE EXISTING*)
  931.    XCLOSE(AFD)
  932.  END;
  933.  FOR I:=1 TO NFILES DO
  934.    IF(FSTAT[I]=FALSE)THEN BEGIN
  935.       ADDFILE(FNAME[I],TFD);
  936.       FSTAT[I]:=TRUE
  937.     END;
  938.     XCLOSE(TFD);
  939.     IF(ERRCOUNT=0)THEN
  940.       FMOVE(ARCHTEMP,ANAME)
  941.     ELSE
  942.       WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
  943.     REMOVE (ARCHTEMP)
  944.   END;
  945. PROCEDURE TABLE(VAR ANAME:XSTRING);
  946. VAR
  947.   HEAD,NAME:XSTRING;
  948.   SIZE:INTEGER;
  949.   AFD:FILEDESC;
  950. PROCEDURE TPRINT(VAR BUF:XSTRING);
  951. VAR
  952.   I:INTEGER;
  953.   TEMP:XSTRING;
  954. BEGIN
  955.   I:=GETWORD(BUF,1,TEMP);
  956.   I:=GETWORD(BUF,I,TEMP);
  957.   PUTSTR(TEMP,STDOUT);
  958.   PUTC(BLANK);
  959.   I:=GETWORD(BUF,I,TEMP);(*SIZE*)
  960.   PUTSTR(TEMP,STDOUT);
  961.   PUTC(NEWLINE)
  962. END;
  963.  
  964. BEGIN
  965.   AFD:=MUSTOPEN(ANAME,IOREAD);
  966.   WHILE(GETHDR(AFD,HEAD,NAME,SIZE))DO BEGIN
  967.     IF(FILEARG(NAME))THEN
  968.       TPRINT(HEAD);
  969.     FSKIP(AFD,SIZE)
  970.   END;
  971.   NOTFOUND
  972. END;
  973.  
  974. PROCEDURE EXTRACT (VAR ANAME:XSTRING;CMD:CHARACTER);
  975. VAR
  976.   ENAME,PINLINE:XSTRING;
  977.   AFD,EFD:FILEDESC;
  978.   SIZE : INTEGER;
  979. BEGIN
  980.   AFD:=MUSTOPEN(ANAME,IOREAD);
  981.   IF (CMD=ORD('p')) THEN
  982.     EFD:=STDOUT
  983.   ELSE
  984.     EFD:=IOERROR;
  985.   WHILE (GETHDR(AFD,PINLINE,ENAME,SIZE)) DO
  986.     IF (NOT FILEARG(ENAME))THEN
  987.       FSKIP(AFD,SIZE)
  988.     ELSE
  989.       BEGIN
  990.       IF (EFD<> STDOUT) THEN
  991.         EFD:=CREATE(ENAME,IOWRITE);
  992.       IF(EFD=IOERROR) THEN BEGIN
  993.         PUTSTR(ENAME,STDERR);
  994.         WRITELN(': CANT''T CREATE');
  995.         ERRCOUNT:=ERRCOUNT+1;
  996.         FSKIP(AFD,SIZE)
  997.       END
  998.       ELSE BEGIN
  999.         ACOPY(AFD,EFD,SIZE);
  1000.         IF(EFD<>STDOUT)THEN
  1001.         XCLOSE(EFD)
  1002.       END
  1003.     END;
  1004.     NOTFOUND
  1005.   END;
  1006.  
  1007. PROCEDURE DELETE(VAR ANAME:XSTRING);
  1008. VAR
  1009.   AFD,TFD:FILEDESC;
  1010. BEGIN
  1011.   IF(NFILES<=0)THEN(*PROTECT INNOCENT*)
  1012.     ERROR('ARCHIVE:-D REQUIRES EXPLICIT FILE NAMES');
  1013.   AFD:=MUSTOPEN(ANAME,IOREAD);
  1014.   TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  1015.   REPLACE(AFD,TFD,ORD('d'));
  1016.   NOTFOUND;
  1017.   XCLOSE(AFD);
  1018.   XCLOSE(TFD);
  1019.   IF(ERRCOUNT=0)THEN
  1020.     FMOVE(ARCHTEMP,ANAME)
  1021.   ELSE
  1022.     WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
  1023.   REMOVE(ARCHTEMP)
  1024. END;
  1025.  
  1026.  
  1027. PROCEDURE INITARCH;
  1028. BEGIN
  1029.   ARCHTEMP[1]:=ORD('A');
  1030.   ARCHTEMP[2]:=ORD('R');
  1031.   ARCHTEMP[3]:=ORD('T');
  1032.   ARCHTEMP[4]:=ORD('E');
  1033.   ARCHTEMP[5]:=ORD('M');
  1034.   ARCHTEMP[6]:=ORD('P');
  1035.   ARCHTEMP[7]:=ENDSTR;
  1036.   ARCHHDR[1]:=ORD('-');
  1037.   ARCHHDR[2]:=ORD('H');
  1038.   ARCHHDR[3]:=ORD('-');
  1039.   ARCHHDR[4]:=ENDSTR;
  1040. END;
  1041.  
  1042.  
  1043. BEGIN
  1044.   INITARCH;
  1045.   IF (NOT GETARG(2,CMD,MAXSTR))
  1046.     OR(NOT GETARG(3,ANAME,MAXSTR)) THEN
  1047.       HELP;
  1048.   GETFNS;
  1049.   IF(XLENGTH(CMD)<>2) OR(CMD[1]<>ORD('-')) THEN
  1050.     HELP
  1051.   ELSE IF (CMD[2]=ORD('c'))OR(CMD[2]=ORD('u'))THEN
  1052.     UPDATE(ANAME,CMD[2])
  1053.   ELSE IF (CMD[2]=ORD('t'))THEN
  1054.     TABLE(ANAME)
  1055.   ELSE IF (CMD[2]=ORD('x'))OR(CMD[2]=ORD('p'))THEN
  1056.     EXTRACT(ANAME,CMD[2])
  1057.   ELSE IF (CMD[2]=ORD('d'))THEN
  1058.     DELETE(ANAME)
  1059.   ELSE
  1060.     HELP
  1061. END;
  1062.  
  1063.  
  1064.  
  1065. SHAR_EOF
  1066. if test 11306 -ne "`wc -c < 'chapter3.pas'`"
  1067. then
  1068.     echo shar: error transmitting "'chapter3.pas'" '(should have been 11306 characters)'
  1069. fi
  1070. fi # end of overwriting check
  1071. echo shar: extracting "'chapter4.pas'" '(7602 characters)'
  1072. if test -f 'chapter4.pas'
  1073. then
  1074.     echo shar: will not over-write existing file "'chapter4.pas'"
  1075. else
  1076. cat << \SHAR_EOF > 'chapter4.pas'
  1077. {chapter4.pas}
  1078.  
  1079. {
  1080.         Copyright (c) 1981
  1081.         By:     Bell Telephone Laboratories, Inc. and
  1082.                 Whitesmith's Ltd.,
  1083.  
  1084.         This software is derived from the book
  1085.                 "Software Tools in Pascal", by
  1086.                 Brian W. Kernighan and P. J. Plauger
  1087.                 Addison-Wesley, 1981
  1088.                 ISBN 0-201-10342-7
  1089.  
  1090.         Right is hereby granted to freely distribute or duplicate this
  1091.         software, providing distribution or duplication is not for profit
  1092.         or other commercial gain and that this copyright notice remains
  1093.         intact.
  1094. }
  1095.  
  1096. PROCEDURE SORT;
  1097. CONST
  1098.   MAXCHARS=10000;
  1099.   MAXLINES=300;
  1100.   MERGEORDER=5;
  1101. TYPE
  1102.   CHARPOS=1..MAXCHARS;
  1103.   CHARBUF=ARRAY[1..MAXCHARS] OF CHARACTER;
  1104.   POSBUF=ARRAY[1..MAXLINES] OF CHARPOS;
  1105.   POS=0..MAXLINES;
  1106.   FDBUF=ARRAY[1..MERGEORDER]OF FILEDESC;
  1107. VAR
  1108.   LINEBUF:CHARBUF;
  1109.   LINEPOS:POSBUF;
  1110.   NLINES:POS;
  1111.   INFILE:FDBUF;
  1112.   OUTFILE:FILEDESC;
  1113.   HIGH,LOW,LIM:INTEGER;
  1114.   DONE:BOOLEAN;
  1115.   NAME:XSTRING;
  1116. FUNCTION GTEXT(VAR LINEPOS:POSBUF;VAR NLINES:POS;
  1117.   VAR LINEBUF:CHARBUF;INFILE:FILEDESC):BOOLEAN;
  1118. VAR
  1119.   I,LEN,NEXTPOS:INTEGER;
  1120.   TEMP:XSTRING;
  1121.   DONE:BOOLEAN;
  1122. BEGIN
  1123.   NLINES:=0;
  1124.   NEXTPOS:=1;
  1125.   REPEAT
  1126.     DONE:=(GETLINE(TEMP,INFILE,MAXSTR)=FALSE);
  1127.     IF(NOT DONE) THEN BEGIN
  1128.       NLINES:=NLINES+1;
  1129.       LINEPOS[NLINES]:=NEXTPOS;
  1130.       LEN:=XLENGTH(TEMP);
  1131.       FOR I:=1 TO LEN DO
  1132.         LINEBUF[NEXTPOS+I-1]:=TEMP[I];
  1133.       LINEBUF[NEXTPOS+LEN]:=ENDSTR;
  1134.       NEXTPOS:=NEXTPOS+LEN+1
  1135.     END
  1136.   UNTIL (DONE) OR (NEXTPOS>= MAXCHARS-MAXSTR)
  1137.     OR (NLINES>=MAXLINES);
  1138.   GTEXT:=DONE
  1139. END;
  1140.  
  1141. PROCEDURE PTEXT(VAR LINEPOS:POSBUF;NLINES:INTEGER;
  1142.   VAR LINEBUF:CHARBUF;OUTFILE:FILEDESC);
  1143. VAR
  1144.   I,J:INTEGER;
  1145. BEGIN
  1146.   FOR I:=1 TO NLINES DO BEGIN
  1147.       J:=LINEPOS[I];
  1148.       WHILE (LINEBUF[J]<>ENDSTR)DO BEGIN
  1149.         PUTCF(LINEBUF[J],OUTFILE);
  1150.         J:=J+1
  1151.       END
  1152.     END
  1153. END;
  1154.  
  1155.       
  1156.  
  1157. PROCEDURE EXCHANGE(VAR LP1,LP2:CHARPOS);
  1158. VAR
  1159.   TEMP:CHARPOS;
  1160. BEGIN
  1161.   TEMP:=LP1;
  1162.   LP1:=LP2;
  1163.   LP2:=TEMP
  1164. END;
  1165.  
  1166. FUNCTION CMP (I,J:CHARPOS;VAR LINEBUF:CHARBUF)
  1167.    :INTEGER;
  1168. BEGIN
  1169.   WHILE(LINEBUF[I]=LINEBUF[J])
  1170.    AND (LINEBUF[I]<>ENDSTR) DO BEGIN
  1171.      I:=I+1;
  1172.      J:=J+1
  1173.    END;
  1174.    IF(LINEBUF[I]=LINEBUF[J]) THEN
  1175.      CMP:=0
  1176.    ELSE IF (LINEBUF[I]=ENDSTR) THEN
  1177.      CMP:=-1
  1178.    ELSE IF (LINEBUF[J]=ENDSTR) THEN
  1179.      CMP:=+1
  1180.    ELSE IF (LINEBUF[I]<LINEBUF[J]) THEN
  1181.      CMP:=-1
  1182.    ELSE
  1183.      CMP:=+1
  1184. END;(*CMP*)
  1185.  
  1186.  
  1187. PROCEDURE QUICK(VAR LINEPOS:POSBUF; NLINE:POS;
  1188.   VAR LINEBUF:CHARBUF);
  1189. PROCEDURE RQUICK(LO,HI:INTEGER);
  1190. VAR
  1191.   I,J:INTEGER;
  1192.   PIVLINE:CHARPOS;
  1193. BEGIN
  1194.   IF (LO<HI) THEN BEGIN
  1195.     I:=LO;
  1196.     J:=HI;
  1197.     PIVLINE:=LINEPOS[J];
  1198.     REPEAT
  1199.       WHILE (I<J)
  1200.         AND (CMP(LINEPOS[I],PIVLINE,LINEBUF)<=0) DO
  1201.           I:=I+1;
  1202.       WHILE  (J>I)
  1203.         AND (CMP(LINEPOS[J],PIVLINE,LINEBUF)>=0) DO
  1204.           J:=J-1;
  1205.       IF(I<J) THEN
  1206.       (*OUT OF ORDER PAIR*)
  1207.         EXCHANGE(LINEPOS[I],LINEPOS[J])
  1208.     UNTIL (I>=J);
  1209.     EXCHANGE(LINEPOS[I],LINEPOS[HI]);
  1210.     IF(I-LO<HI-I) THEN BEGIN
  1211.       RQUICK(LO,I-1);
  1212.       RQUICK(I+1,HI)
  1213.     END
  1214.     ELSE BEGIN
  1215.       RQUICK(I+1,HI);
  1216.       RQUICK(LO,I-1)
  1217.     END
  1218.   END
  1219. END;(*RQUICK*)
  1220.  
  1221. BEGIN(*QUICK*)
  1222.   RQUICK(1,NLINES)
  1223. END;
  1224.  
  1225.  
  1226. PROCEDURE GNAME(N:INTEGER;VAR NAME:XSTRING);
  1227. VAR
  1228.   JUNK:INTEGER;
  1229.   BEGIN
  1230.     NAME[1]:=ORD('S');
  1231.     NAME[2]:=ORD('T');
  1232.     NAME[3]:=ORD('E');
  1233.     NAME[4]:=ORD('M');
  1234.     NAME[5]:=ORD('P');
  1235.     NAME[6]:=ENDSTR;
  1236.   JUNK:=ITOC(N,NAME,XLENGTH(NAME)+1)
  1237. END;
  1238.  
  1239. PROCEDURE GOPEN(VAR INFILE:FDBUF;F1,F2:INTEGER);
  1240. VAR
  1241.   NAME:XSTRING;
  1242.   I:1..MERGEORDER;
  1243. BEGIN
  1244.   FOR I:=1 TO F2-F1+1 DO BEGIN
  1245.     GNAME(F1+I-1,NAME);
  1246.     INFILE[I]:=MUSTOPEN(NAME,IOREAD)
  1247.   END
  1248. END;
  1249.  
  1250. PROCEDURE GREMOVE(VAR INFILE:FDBUF;F1,F2:INTEGER);
  1251. VAR
  1252.   NAME:XSTRING;
  1253.   I:1..MERGEORDER;
  1254. BEGIN
  1255.   FOR I:= 1 TO F2-F1+1 DO BEGIN
  1256.     XCLOSE(INFILE[I]);
  1257.     GNAME(F1+I-1,NAME);
  1258.     REMOVE(NAME)
  1259.   END
  1260. END;
  1261.  
  1262.  
  1263. FUNCTION MAKEFILE(N:INTEGER):FILEDESC;
  1264. VAR
  1265.   NAME:XSTRING;
  1266. BEGIN
  1267.   GNAME(N,NAME);
  1268.  
  1269.   MAKEFILE:=MUSTCREATE(NAME,IOWRITE)
  1270. END;
  1271.  
  1272. PROCEDURE MERGE(VAR INFILE:FDBUF; NF:INTEGER;
  1273.   OUTFILE:FILEDESC);
  1274.  
  1275. VAR
  1276.   I,J:INTEGER;
  1277.   LBP:CHARPOS;
  1278.   TEMP:XSTRING;
  1279.  
  1280. PROCEDURE REHEAP(VAR LINEPOS:POSBUF;NF:POS;
  1281.   VAR LINEBUF:CHARBUF);
  1282. VAR
  1283.   I,J:INTEGER;
  1284. BEGIN
  1285.   I:=1;
  1286.   J:=2*I;
  1287.   WHILE(J<=NF)DO BEGIN
  1288.     IF(J<NF) THEN
  1289.       IF(CMP(LINEPOS[J],LINEPOS[J+1],LINEBUF)>0)THEN
  1290.         J:=J+1;
  1291.     IF(CMP(LINEPOS[I],LINEPOS[J],LINEBUF)<=0)THEN
  1292.       I:=NF
  1293.     ELSE
  1294.       EXCHANGE(LINEPOS[I],LINEPOS[J]);(*PERCOLATE*)
  1295.     I:=J;
  1296.     J:=2*I
  1297.   END
  1298. END;
  1299.  
  1300. PROCEDURE SCCOPY(VAR S:XSTRING; VAR CB:CHARBUF;
  1301.   I:CHARPOS);
  1302. VAR J:INTEGER;
  1303. BEGIN
  1304.   J:=1;
  1305.   WHILE(S[J]<>ENDSTR)DO BEGIN
  1306.     CB[I]:=S[J];
  1307.     J:=J+1;
  1308.     I:=I+1
  1309.   END;
  1310.   CB[I]:=ENDSTR
  1311. END;
  1312.  
  1313. PROCEDURE CSCOPY(VAR CB:CHARBUF;I:CHARPOS;
  1314.   VAR S:XSTRING);
  1315. VAR J:INTEGER;
  1316. BEGIN
  1317.   J:=1;
  1318.   WHILE(CB[I]<>ENDSTR)DO BEGIN
  1319.     S[J]:=CB[I];
  1320.     I:=I+1;
  1321.     J:=J+1
  1322.   END;
  1323.   S[J]:=ENDSTR
  1324. END;
  1325.  
  1326. BEGIN(*MERGE*)
  1327.   J:=0;
  1328.   FOR I:=1 TO NF DO
  1329.     IF(GETLINE(TEMP,INFILE[I],MAXSTR)) THEN BEGIN
  1330.       LBP:=(I-1)*MAXSTR+1;
  1331.       SCCOPY(TEMP,LINEBUF,LBP);
  1332.       LINEPOS[I]:=LBP;
  1333.       J:=J+1
  1334.     END;
  1335.   NF:=J;
  1336.   QUICK(LINEPOS,NF,LINEBUF);
  1337.   WHILE (NF>0) DO BEGIN
  1338.     LBP:=LINEPOS[1];
  1339.     CSCOPY(LINEBUF,LBP,TEMP);
  1340.     PUTSTR(TEMP,OUTFILE);
  1341.     I:=LBP DIV MAXSTR +1;
  1342.     IF (GETLINE(TEMP,INFILE[I],MAXSTR))THEN
  1343.       SCCOPY(TEMP,LINEBUF,LBP)
  1344.     ELSE BEGIN
  1345.       LINEPOS[1]:=LINEPOS[NF];
  1346.       NF:=NF-1
  1347.     END;
  1348.     REHEAP(LINEPOS,NF,LINEBUF)
  1349.   END
  1350. END;
  1351.  
  1352.  
  1353. BEGIN
  1354.   HIGH:=0;
  1355.   REPEAT (*INITIAL FORMTION OF RUNS*)
  1356.     DONE:=GTEXT(LINEPOS,NLINES,LINEBUF,STDIN);
  1357.     QUICK(LINEPOS,NLINES,LINEBUF);
  1358.     HIGH:=HIGH+1;
  1359.     OUTFILE:=MAKEFILE(HIGH);
  1360.     PTEXT(LINEPOS,NLINES,LINEBUF,OUTFILE);
  1361.     XCLOSE(OUTFILE)
  1362.   UNTIL (DONE);
  1363.   LOW:=1;
  1364.   WHILE (LOW<HIGH) DO BEGIN
  1365.     LIM:=MIN(LOW+MERGEORDER-1,HIGH);
  1366.     GOPEN(INFILE,LOW,LIM);
  1367.     HIGH:=HIGH+1;
  1368.     OUTFILE:=MAKEFILE(HIGH);
  1369.     MERGE(INFILE,LIM-LOW+1,OUTFILE);
  1370.     XCLOSE(OUTFILE);
  1371.     GREMOVE(INFILE,LOW,LIM);
  1372.     LOW:=LOW+MERGEORDER
  1373.   END;
  1374.   GNAME(HIGH,NAME);
  1375.   OUTFILE:=OPEN(NAME,IOREAD);
  1376.   FCOPY(OUTFILE,STDOUT);
  1377.   XCLOSE(OUTFILE);
  1378.   REMOVE(NAME)
  1379. END;
  1380.  
  1381. PROCEDURE UNIQUE;
  1382. VAR
  1383.   BUF:ARRAY[0..1] OF XSTRING;
  1384.   CUR:0..1;
  1385. BEGIN
  1386.   CUR:=1;
  1387.   BUF[1-CUR][1]:=ENDSTR;
  1388.   WHILE (GETLINE(BUF[CUR],STDIN,MAXSTR))DO
  1389.     IF (NOT EQUAL (BUF[CUR],BUF[1-CUR])) THEN BEGIN
  1390.       PUTSTR(BUF[CUR],STDOUT);
  1391.       CUR:=1-CUR
  1392.     END
  1393. END;
  1394.  
  1395. PROCEDURE KWIC;
  1396. CONST
  1397.   FOLD=DOLLAR;
  1398. VAR
  1399.   BUF:XSTRING;
  1400.  
  1401. PROCEDURE PUTROT(VAR BUF:XSTRING);
  1402. VAR I:INTEGER;
  1403.  
  1404. PROCEDURE ROTATE(VAR BUF:XSTRING;N:INTEGER);
  1405. VAR I:INTEGER;
  1406. BEGIN
  1407.   I:=N;
  1408.   WHILE (BUF[I]<>NEWLINE) AND (BUF[I]<>ENDSTR) DO BEGIN
  1409.     PUTC(BUF[I]);
  1410.     I:=I+1
  1411.   END;
  1412.   PUTC(FOLD);
  1413.   FOR I:=1 TO N-1 DO
  1414.     PUTC(BUF[I]);
  1415.   PUTC(NEWLINE)
  1416. END;(*ROTATE*)
  1417.  
  1418. BEGIN(*PUTROT*)
  1419.   I:=1;
  1420.   WHILE(BUF[I]<>NEWLINE) AND (BUF[I]<>ENDSTR) DO BEGIN
  1421.     IF (ISALPHANUM(BUF[I])) THEN BEGIN
  1422.       ROTATE(BUF,I);(*TOKEN STATRS AT "I"*)
  1423.     REPEAT
  1424.       I:=I+1
  1425.     UNTIL (NOT ISALPHANUM(BUF[I]))
  1426.   END;
  1427.   I:=I+1
  1428.   END
  1429.   
  1430. END;(*PUTROT*)
  1431.  
  1432. BEGIN(*KWIC*)
  1433.   WHILE(GETLINE(BUF,STDIN,MAXSTR))DO
  1434.     PUTROT(BUF)
  1435. END;
  1436.  
  1437. PROCEDURE UNROTATE;
  1438. CONST
  1439.   MAXOUT=80;
  1440.   MIDDLE=40;
  1441.   FOLD=DOLLAR;
  1442. VAR
  1443.   INBUF,OUTBUF:XSTRING;
  1444.   I,J,F:INTEGER;
  1445. BEGIN
  1446.   WHILE(GETLINE(INBUF,STDIN,MAXSTR))DO BEGIN
  1447.     FOR I:=1 TO MAXOUT-1 DO
  1448.       OUTBUF[I]:=BLANK;
  1449.     F:=INDEX(INBUF,FOLD);
  1450.     J:=MIDDLE-1;
  1451.     FOR I:=XLENGTH(INBUF)-1 DOWNTO F+1 DO BEGIN
  1452.       OUTBUF[J]:=INBUF[I];
  1453.       J:=J-1;
  1454.       IF(J<=0)THEN
  1455.         J:=MAXOUT-1
  1456.     END;
  1457.     J:=MIDDLE+1;
  1458.     FOR I:=1 TO F-1 DO BEGIN
  1459.       OUTBUF[J]:=INBUF[I];
  1460.       J:=J MOD (MAXOUT-1) +1
  1461.     END;
  1462.     FOR J:=1 TO MAXOUT-1 DO
  1463.       IF(OUTBUF[J]<>BLANK) THEN
  1464.         I:=J;
  1465.     OUTBUF[I+1]:=ENDSTR;
  1466.     PUTSTR(OUTBUF,STDOUT);
  1467.     PUTC(NEWLINE)
  1468.   END
  1469. END;
  1470.  
  1471.  
  1472.  
  1473.  
  1474.  
  1475. SHAR_EOF
  1476. if test 7602 -ne "`wc -c < 'chapter4.pas'`"
  1477. then
  1478.     echo shar: error transmitting "'chapter4.pas'" '(should have been 7602 characters)'
  1479. fi
  1480. fi # end of overwriting check
  1481. echo shar: extracting "'chapter5.pas'" '(8365 characters)'
  1482. if test -f 'chapter5.pas'
  1483. then
  1484.     echo shar: will not over-write existing file "'chapter5.pas'"
  1485. else
  1486. cat << \SHAR_EOF > 'chapter5.pas'
  1487. {chapter5.pas}
  1488.  
  1489. {
  1490.         Copyright (c) 1981
  1491.         By:     Bell Telephone Laboratories, Inc. and
  1492.                 Whitesmith's Ltd.,
  1493.  
  1494.         This software is derived from the book
  1495.                 "Software Tools in Pascal", by
  1496.                 Brian W. Kernighan and P. J. Plauger
  1497.                 Addison-Wesley, 1981
  1498.                 ISBN 0-201-10342-7
  1499.  
  1500.         Right is hereby granted to freely distribute or duplicate this
  1501.         software, providing distribution or duplication is not for profit
  1502.         or other commercial gain and that this copyright notice remains
  1503.         intact.
  1504. }
  1505.  
  1506. CONST
  1507.   MAXPAT=MAXSTR;
  1508.   CLOSIZE=1;
  1509.   CLOSURE=STAR;
  1510.   BOL=PERCENT;
  1511.   EOL=DOLLAR;
  1512.   ANY=QUESTION;
  1513.   CCL=LBRACK;
  1514.   CCLEND=RBRACK;
  1515.   NEGATE=CARET;
  1516.   NCCL=EXCLAM;
  1517.   LITCHAR=67;
  1518.  
  1519. FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  1520.   DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  1521.   
  1522. FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
  1523.   VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
  1524. FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;
  1525.  
  1526. FUNCTION MAKEPAT;
  1527. VAR
  1528.   I,J,LASTJ,LJ:INTEGER;
  1529.   DONE,JUNK:BOOLEAN;
  1530.  
  1531. FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  1532.   VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
  1533. VAR
  1534.   JSTART:INTEGER;
  1535.   JUNK:BOOLEAN;
  1536.  
  1537. PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  1538.   VAR I:INTEGER; VAR DEST:XSTRING;
  1539.   VAR J:INTEGER; MAXSET:INTEGER);
  1540. CONST ESCAPE=ATSIGN;
  1541. VAR K:INTEGER;
  1542. JUNK:BOOLEAN;
  1543.  
  1544. FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
  1545. BEGIN
  1546.   IF(S[I]<>ESCAPE) THEN
  1547.     ESC:=S[I]
  1548.   ELSE IF (S[I+1]=ENDSTR) THEN
  1549.     ESC:=ESCAPE
  1550.   ELSE BEGIN
  1551.     I:=I+1;
  1552.     IF (S[I]=ORD('N')) THEN
  1553.       ESC:=NEWLINE
  1554.     ELSE IF (S[I]=ORD('T')) THEN
  1555.       ESC:=TAB
  1556.     ELSE
  1557.       ESC:=S[I]
  1558.     END
  1559. END;
  1560.  
  1561. BEGIN
  1562.   WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
  1563.     IF(SRC[I]=ESCAPE)THEN
  1564.       JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
  1565.     ELSE IF (SRC[I]<>DASH) THEN
  1566.       JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
  1567.     ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
  1568.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
  1569.     ELSE IF (ISALPHANUM(SRC[I-1]))
  1570.       AND (ISALPHANUM(SRC[I+1]))
  1571.       AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
  1572.         FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
  1573.           JUNK:=ADDSTR(K,DEST,J,MAXSET);
  1574.             I:=I+1
  1575.     END
  1576.     ELSE
  1577.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
  1578.     I:=I+1
  1579.   END
  1580. END;
  1581.  
  1582. BEGIN
  1583.   I:=I+1;
  1584.   IF(ARG[I]=NEGATE) THEN BEGIN
  1585.     JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
  1586.     I:=I+1
  1587.   END
  1588.   ELSE
  1589.     JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  1590.   JSTART:=J;
  1591.   JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  1592.   DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  1593.   PAT[JSTART]:=J-JSTART-1;
  1594.   GETCCL:=(ARG[I]=CCLEND)
  1595. END;
  1596.  
  1597. PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  1598.   LASTJ:INTEGER);
  1599. VAR
  1600.   JP,JT:INTEGER;
  1601.   JUNK:BOOLEAN;
  1602. BEGIN
  1603.   FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
  1604.     JT:=JP+CLOSIZE;
  1605.     JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  1606.   END;
  1607.   J:=J+CLOSIZE;
  1608.   PAT[LASTJ]:=CLOSURE
  1609. END;
  1610.  
  1611. BEGIN
  1612.   J:=1;
  1613.   I:=START;
  1614.   LASTJ:=1;
  1615.   DONE:=FALSE;
  1616.   WHILE(NOT DONE) AND (ARG[I]<>DELIM)
  1617.     AND (ARG[I]<>ENDSTR) DO BEGIN
  1618.       LJ:=J;
  1619.       IF(ARG[I]=ANY) THEN
  1620.         JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
  1621.       ELSE IF (ARG[I]=BOL) AND (I=START) THEN
  1622.         JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
  1623.       ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
  1624.         JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
  1625.       ELSE IF (ARG[I]=CCL) THEN
  1626.         DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
  1627.       ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
  1628.         LJ:=LASTJ;
  1629.         IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
  1630.           DONE:=TRUE
  1631.         ELSE
  1632.           STCLOSE(PAT,J,LASTJ)
  1633.       END
  1634.       ELSE BEGIN
  1635.         JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
  1636.         JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
  1637.       END;
  1638.       LASTJ:=LJ;
  1639.       IF(NOT DONE) THEN
  1640.         I:=I+1
  1641.     END;
  1642.     IF(DONE) OR (ARG[I]<>DELIM) THEN
  1643.       MAKEPAT:=0
  1644.     ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
  1645.       MAKEPAT:=0
  1646.     ELSE
  1647.       MAKEPAT:=I
  1648.   END;
  1649.   
  1650.  
  1651. FUNCTION AMATCH;
  1652.  
  1653.  
  1654. VAR I,K:INTEGER;
  1655.    DONE:BOOLEAN;
  1656.  
  1657.  
  1658. FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  1659.   VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
  1660. VAR
  1661.   ADVANCE:-1..1;
  1662.  
  1663.  
  1664. FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  1665.   OFFSET:INTEGER):BOOLEAN;
  1666. VAR
  1667.   I:INTEGER;
  1668. BEGIN
  1669.   LOCATE:=FALSE;
  1670.   I:=OFFSET+PAT[OFFSET];
  1671.   WHILE(I>OFFSET) DO
  1672.     IF(C=PAT[I]) THEN BEGIN
  1673.       LOCATE :=TRUE;
  1674.       I:=OFFSET
  1675.     END
  1676.     ELSE
  1677.       I:=I-1
  1678. END;BEGIN
  1679.   ADVANCE:=-1;
  1680.   IF(LIN[I]=ENDSTR) THEN
  1681.     OMATCH:=FALSE
  1682.   ELSE IF (NOT( PAT[J] IN
  1683.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  1684.      ERROR('IN OMATCH:CAN''T HAPPEN')
  1685.   ELSE
  1686.     CASE PAT[J] OF
  1687.     LITCHAR:
  1688.       IF (LIN[I]=PAT[J+1]) THEN
  1689.         ADVANCE:=1;
  1690.     BOL:
  1691.       IF (I=1) THEN
  1692.         ADVANCE:=0;
  1693.     ANY:
  1694.       IF (LIN[I]<>NEWLINE) THEN
  1695.         ADVANCE:=1;
  1696.     EOL:
  1697.       IF(LIN[I]=NEWLINE) THEN
  1698.         ADVANCE:=0;
  1699.     CCL:
  1700.       IF(LOCATE(LIN[I],PAT,J+1)) THEN
  1701.         ADVANCE:=1;
  1702.     NCCL:
  1703.       IF(LIN[I]<>NEWLINE)
  1704.         AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
  1705.           ADVANCE:=1
  1706.         END;
  1707.     IF(ADVANCE>=0) THEN BEGIN
  1708.       I:=I+ADVANCE;
  1709.       OMATCH:=TRUE
  1710.     END
  1711.     ELSE
  1712.       OMATCH:=FALSE
  1713.   END;
  1714.   
  1715. FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
  1716. BEGIN
  1717.   IF(NOT (PAT[N] IN
  1718.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  1719.     ERROR('IN PATSIZE:CAN''T HAPPEN')
  1720.   ELSE
  1721.     CASE PAT[N] OF
  1722.       LITCHAR:PATSIZE:=2;
  1723.       BOL,EOL,ANY:PATSIZE:=1;
  1724.       CCL,NCCL:PATSIZE:=PAT[N+1]+2;
  1725.       CLOSURE:PATSIZE:=CLOSIZE
  1726.     END
  1727. END;
  1728.  
  1729. BEGIN
  1730.   DONE:=FALSE;
  1731.   WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
  1732.     IF(PAT[J]=CLOSURE) THEN BEGIN
  1733.       J:=J+PATSIZE(PAT,J);
  1734.       I:=OFFSET;
  1735.       WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
  1736.         IF (NOT OMATCH(LIN,I,PAT,J)) THEN
  1737.           DONE:=TRUE;
  1738.       DONE:=FALSE;
  1739.       WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
  1740.         K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
  1741.         IF(K>0) THEN
  1742.           DONE:=TRUE
  1743.         ELSE
  1744.           I:=I-1
  1745.       END;
  1746.       OFFSET:=K;
  1747.       DONE:=TRUE
  1748.     END
  1749.     ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
  1750.       THEN BEGIN
  1751.       OFFSET :=0;
  1752.       DONE:=TRUE
  1753.     END
  1754.     ELSE
  1755.       J:=J+PATSIZE(PAT,J);
  1756.   AMATCH:=OFFSET
  1757. END;
  1758. FUNCTION MATCH;
  1759.  
  1760. VAR
  1761.   I,POS:INTEGER;
  1762.  
  1763.   
  1764.                                                                                
  1765. BEGIN
  1766.   POS:=0;
  1767.   I:=1;
  1768.   WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
  1769.     POS:=AMATCH(LIN,I,PAT,1);
  1770.     I:=I+1
  1771.   END;
  1772.   MATCH:=(POS>0)
  1773. END;
  1774.  
  1775.  
  1776.  
  1777.  
  1778. PROCEDURE FIND;
  1779.   
  1780. VAR
  1781.   ARG,LIN,PAT:XSTRING;
  1782.  
  1783. FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;
  1784.  
  1785.   
  1786.  
  1787. BEGIN
  1788.   GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
  1789. END;
  1790.  
  1791.  
  1792. BEGIN
  1793.   IF(NOT GETARG(2,ARG,MAXSTR))THEN
  1794.     ERROR('USAGE:FIND PATTERN');
  1795.   IF (NOT GETPAT(ARG,PAT)) THEN
  1796.     ERROR('FIND:ILLEGAL PATTERN');
  1797.   WHILE(GETLINE(LIN,STDIN,MAXSTR))DO
  1798.     IF (MATCH(LIN,PAT))THEN
  1799.       PUTSTR(LIN,STDOUT)
  1800. END;
  1801.  
  1802. PROCEDURE CHANGE;
  1803. CONST
  1804.   DITTO=255;
  1805. VAR
  1806.   LIN,PAT,SUB,ARG:XSTRING;
  1807.  
  1808. FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;
  1809.  
  1810.   
  1811.  
  1812. BEGIN
  1813.   GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
  1814. END;
  1815. FUNCTION GETSUB(VAR ARG,SUB:XSTRING):BOOLEAN;
  1816.  
  1817. FUNCTION MAKESUB(VAR ARG:XSTRING; FROM:INTEGER;
  1818.   DELIM:CHARACTER; VAR SUB:XSTRING):INTEGER;
  1819. VAR I,J:INTEGER;
  1820.    JUNK:BOOLEAN;
  1821. BEGIN
  1822.   J:=1;
  1823.   I:=FROM;
  1824.   WHILE (ARG[I]<>DELIM) AND (ARG[I]<>ENDSTR) DO BEGIN
  1825.     IF(ARG[I]=ORD('&')) THEN
  1826.       JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
  1827.     ELSE
  1828.       JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
  1829.     I:=I+1
  1830.   END;
  1831.   IF (ARG[I]<>DELIM) THEN
  1832.     MAKESUB:=0
  1833.   ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT)) THEN
  1834.     MAKESUB:=0
  1835.   ELSE
  1836.     MAKESUB:=I
  1837. END;
  1838.  
  1839. BEGIN
  1840.   GETSUB:=(MAKESUB(ARG,1,ENDSTR,SUB)>0)
  1841. END;
  1842.  
  1843. PROCEDURE SUBLINE(VAR LIN,PAT,SUB:XSTRING);
  1844. VAR
  1845.   I, LASTM, M:INTEGER;
  1846.   JUNK:BOOLEAN;
  1847.  
  1848.  
  1849. PROCEDURE PUTSUB(VAR LIN:XSTRING; S1,S2:INTEGER;
  1850.   VAR SUB:XSTRING);
  1851. VAR
  1852.   I,J:INTEGER;
  1853.   JUNK:BOOLEAN;
  1854. BEGIN
  1855.   I:=1;
  1856.   WHILE (SUB[I]<>ENDSTR) DO BEGIN
  1857.     IF(SUB[I]=DITTO) THEN
  1858.       FOR J:=S1 TO S2-1 DO
  1859.         PUTC(LIN[J])
  1860.       ELSE
  1861.         PUTC(SUB[I]);
  1862.       I:=I+1
  1863.   END
  1864. END;
  1865.  
  1866. BEGIN
  1867.   LASTM:=0;
  1868.   I:=1;
  1869.   WHILE(LIN[I]<>ENDSTR) DO BEGIN
  1870.     M:=AMATCH(LIN,I,PAT,1);
  1871.     IF (M>0) AND (LASTM<>M) THEN BEGIN
  1872.       PUTSUB(LIN,I,M,SUB);
  1873.       LASTM:=M
  1874.     END;
  1875.     IF (M=0) OR (M=I) THEN BEGIN
  1876.       PUTC(LIN[I]);
  1877.       I:=I+1
  1878.     END
  1879.     ELSE
  1880.       I:=M
  1881.     END
  1882. END;
  1883.  
  1884. BEGIN
  1885.   IF(NOT GETARG(2,ARG,MAXSTR)) THEN
  1886.     ERROR('USAGE:CHANGE FROM [TO]');
  1887.   IF (NOT GETPAT(ARG,PAT)) THEN
  1888.     ERROR('CHANGE:ILLEGAL "FROM" PATTERN');
  1889.   IF (NOT GETARG(3,ARG,MAXSTR)) THEN
  1890.     ARG[1]:=ENDSTR;
  1891.   IF(NOT GETSUB(ARG,SUB)) THEN
  1892.     ERROR('CHANGE:ILLEGAL "TO" STRING');
  1893.   WHILE (GETLINE(LIN,STDIN,MAXSTR)) DO
  1894.     SUBLINE(LIN,PAT,SUB)
  1895. END;
  1896.  
  1897.  
  1898.  
  1899. SHAR_EOF
  1900. if test 8365 -ne "`wc -c < 'chapter5.pas'`"
  1901. then
  1902.     echo shar: error transmitting "'chapter5.pas'" '(should have been 8365 characters)'
  1903. fi
  1904. fi # end of overwriting check
  1905. echo shar: extracting "'chapter6.pas'" '(16451 characters)'
  1906. if test -f 'chapter6.pas'
  1907. then
  1908.     echo shar: will not over-write existing file "'chapter6.pas'"
  1909. else
  1910. cat << \SHAR_EOF > 'chapter6.pas'
  1911. {chapter6.pas}
  1912.  
  1913. {
  1914.         Copyright (c) 1981
  1915.         By:     Bell Telephone Laboratories, Inc. and
  1916.                 Whitesmith's Ltd.,
  1917.  
  1918.         This software is derived from the book
  1919.                 "Software Tools in Pascal", by
  1920.                 Brian W. Kernighan and P. J. Plauger
  1921.                 Addison-Wesley, 1981
  1922.                 ISBN 0-201-10342-7
  1923.  
  1924.         Right is hereby granted to freely distribute or duplicate this
  1925.         software, providing distribution or duplication is not for profit
  1926.         or other commercial gain and that this copyright notice remains
  1927.         intact.
  1928. }
  1929.  
  1930. PROCEDURE EDIT;
  1931. CONST
  1932.   MAXLINES=1000;
  1933.   DITTO=255;
  1934.   CURLINE=PERIOD;
  1935.   LASTLINE=DOLLAR;
  1936.   SCAN=47;
  1937.   BACKSCAN=92;
  1938.   ACMD=97;
  1939.   CCMD=99;
  1940.   DCMD=100;
  1941.   ECMD=101;
  1942.   EQCMD=EQUALS;
  1943.   FCMD=102;
  1944.   GCMD=103;
  1945.   ICMD=105;
  1946.   MCMD=109;
  1947.   PCMD=112;
  1948.   QCMD=113;
  1949.   RCMD=114;
  1950.   SCMD=115;
  1951.   WCMD=119;
  1952.   XCMD=120;
  1953.  
  1954. TYPE
  1955.   STCODE=(ENDDATA,ERR,OK);
  1956.   BUFTYPE=RECORD
  1957.     TXT:INTEGER;
  1958.     MARK:BOOLEAN;
  1959.   END;
  1960.  
  1961. VAR
  1962.   EDITFID:FILE OF CHARACTER;
  1963.   BUF:ARRAY[0..MAXLINES]OF BUFTYPE;
  1964.   RECIN:INTEGER;
  1965.   RECOUT:INTEGER;
  1966.   LINE1,LINE2,NLINES,CURLN,LASTLN:INTEGER;
  1967.   PAT,LIN,SAVEFILE:XSTRING;
  1968.   CURSAVE,I:INTEGER;
  1969.   STATUS:STCODE;
  1970.   MORE:BOOLEAN;
  1971.  
  1972.  
  1973.  
  1974.  
  1975.  
  1976.  
  1977.  
  1978. PROCEDURE GETTXT(N:INTEGER;VAR S:XSTRING);
  1979. VAR
  1980.   ch:char;JUNK:BOOLEAN;I:INTEGER;
  1981. BEGIN
  1982.   IF(N=0) THEN
  1983.     S[1]:=ENDSTR
  1984.   ELSE BEGIN
  1985.     i:=0;
  1986.     SEEK(EDITFID,BUF[N].TXT);
  1987.     repeat
  1988.       i:=succ(i);
  1989.       READ(EDITFID,s[i]);
  1990.       RECIN:=RECIN+1;
  1991.     until S[I]=ENDSTR;
  1992.   END
  1993. END;
  1994.  
  1995.  
  1996. FUNCTION GETMARK(N:INTEGER):BOOLEAN;
  1997. BEGIN
  1998.   GETMARK:=BUF[N].MARK
  1999. END;
  2000.  
  2001. PROCEDURE PUTMARK(N:INTEGER;M:BOOLEAN);
  2002. BEGIN
  2003.   BUF[N].MARK:=M
  2004. END;
  2005.  
  2006. FUNCTION DOPRINT(N1,N2:INTEGER):STCODE;
  2007. VAR
  2008.   I:INTEGER;
  2009.   LINE:XSTRING;
  2010. BEGIN
  2011.   IF(N1<=0)THEN
  2012.     DOPRINT:=ERR
  2013.   ELSE BEGIN
  2014.     FOR I:=N1 TO N2 DO BEGIN
  2015.       GETTXT(I,LINE);
  2016.       PUTSTR(LINE,STDOUT)
  2017.     END;
  2018.     CURLN:=N2;
  2019.     DOPRINT:=OK
  2020.   END
  2021. END;
  2022.  
  2023. FUNCTION DEFAULT(DEF1,DEF2:INTEGER;
  2024.   VAR STATUS:STCODE):STCODE;
  2025. BEGIN
  2026.   IF(NLINES=0)THEN BEGIN
  2027.     LINE1:=DEF1;
  2028.     LINE2:=DEF2
  2029.   END;
  2030.   IF(LINE1 > LINE2)OR(LINE1 <=0)THEN
  2031.     STATUS:=ERR
  2032.   ELSE
  2033.     STATUS:=OK;
  2034.   DEFAULT:=STATUS
  2035. END;
  2036.  
  2037. FUNCTION PREVLN(N:INTEGER):INTEGER;
  2038. BEGIN
  2039.   IF(N<=0)THEN
  2040.     PREVLN:=LASTLN
  2041.   ELSE
  2042.     PREVLN:=N-1
  2043. END;
  2044.  
  2045. FUNCTION NEXTLN(N:INTEGER):INTEGER;
  2046. BEGIN
  2047.   IF(N>=LASTLN)THEN
  2048.     NEXTLN:=0
  2049.   ELSE
  2050.     NEXTLN:=N+1
  2051. END;
  2052.  
  2053. FUNCTION PATSCAN(WAY:CHARACTER;VAR N:INTEGER):STCODE;
  2054. VAR
  2055.   DONE:BOOLEAN;
  2056.   LINE:XSTRING;
  2057. BEGIN
  2058.   N:=CURLN;
  2059.   PATSCAN:=ERR;
  2060.   DONE:=FALSE;
  2061.   REPEAT
  2062.     IF(WAY=SCAN)THEN
  2063.       N:=NEXTLN(N)
  2064.     ELSE
  2065.       N:=PREVLN(N);
  2066.     GETTXT(N,LINE);
  2067.     IF(MATCH(LINE,PAT))THEN BEGIN
  2068.       PATSCAN:=OK;
  2069.       DONE:=TRUE
  2070.     END
  2071.   UNTIL(N=CURLN)OR(DONE)
  2072. END;
  2073.  
  2074. FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
  2075. BEGIN
  2076.   IF(S[I]<>ESCAPE) THEN
  2077.     ESC:=S[I]
  2078.   ELSE IF (S[I+1]=ENDSTR) THEN
  2079.     ESC:=ESCAPE
  2080.   ELSE BEGIN
  2081.     I:=I+1;
  2082.     IF (S[I]=ORD('N')) THEN
  2083.       ESC:=NEWLINE
  2084.     ELSE IF (S[I]=ORD('T')) THEN
  2085.       ESC:=TAB
  2086.     ELSE
  2087.       ESC:=S[I]
  2088.     END
  2089. END;
  2090. FUNCTION OPTPAT(VAR LIN:XSTRING;VAR I:INTEGER):STCODE;
  2091. BEGIN
  2092.   IF(LIN[I]=ENDSTR)THEN
  2093.     I:=0
  2094.   ELSE IF(LIN[I+1]=ENDSTR)THEN
  2095.     I:=0
  2096.   ELSE IF(LIN[I+1]=LIN[I])THEN
  2097.     I:=I+1
  2098.   ELSE
  2099.     I:=MAKEPAT(LIN,I+1,LIN[I],PAT);
  2100.   IF(PAT[1]=ENDSTR)THEN
  2101.     I:=0;
  2102.   IF(I=0)THEN BEGIN
  2103.     PAT[1]:=ENDSTR;
  2104.     OPTPAT:=ERR
  2105.   END
  2106.   ELSE
  2107.     OPTPAT:=OK
  2108. END;
  2109.  
  2110. PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
  2111. BEGIN
  2112.   WHILE(S[I]=BLANK)OR(S[I]=TAB)DO
  2113.     I:=I+1
  2114. END;
  2115.  
  2116. FUNCTION GETNUM(VAR LIN:XSTRING;VAR I,NUM:INTEGER;
  2117.   VAR STATUS:STCODE):STCODE;
  2118. BEGIN
  2119.   STATUS:=OK;
  2120.   SKIPBL(LIN,I);
  2121.   IF(ISDIGIT(LIN[I]))THEN BEGIN
  2122.     NUM:=CTOI(LIN,I);
  2123.       I:=I-1
  2124.   END
  2125.   ELSE IF(LIN[I]=CURLINE)THEN
  2126.     NUM:=CURLN
  2127.   ELSE IF(LIN[I]=LASTLINE)THEN
  2128.     NUM:=LASTLN
  2129.   ELSE IF(LIN[I]=SCAN)OR(LIN[I]=BACKSCAN)THEN BEGIN
  2130.     IF(OPTPAT(LIN,I)=ERR)THEN
  2131.       STATUS:=ERR
  2132.     ELSE
  2133.       STATUS:=PATSCAN(LIN[I],NUM)
  2134.   END
  2135.   ELSE
  2136.     STATUS:=ENDDATA;
  2137.   IF(STATUS=OK)THEN
  2138.     I:=I+1;
  2139.   GETNUM:=STATUS
  2140. END;
  2141.  
  2142. FUNCTION GETONE(VAR LIN:XSTRING;VAR I,NUM:INTEGER;
  2143.   VAR STATUS:STCODE):STCODE;
  2144.   VAR
  2145.     ISTART,MUL,PNUM:INTEGER;
  2146.   BEGIN
  2147.     ISTART:=I;
  2148.     NUM:=0;
  2149.     IF(GETNUM(LIN,I,NUM,STATUS)=OK)THEN
  2150.       REPEAT
  2151.         SKIPBL(LIN,I);
  2152.         IF(LIN[I]<>PLUS)AND(LIN[I]<>MINUS)THEN
  2153.           STATUS:=ENDDATA
  2154.         ELSE BEGIN
  2155.           IF(LIN[I]=PLUS)THEN
  2156.             MUL:=+1
  2157.           ELSE
  2158.             MUL:=-1;
  2159.           I:=I+1;
  2160.           IF(GETNUM(LIN,I,PNUM,STATUS)=OK)THEN
  2161.             NUM:=NUM+MUL*PNUM;
  2162.           IF(STATUS=ENDDATA)THEN
  2163.             STATUS:=ERR
  2164.         END
  2165.       UNTIL(STATUS<>OK);
  2166.     IF(NUM<0)OR(NUM > LASTLN)THEN
  2167.       STATUS:=ERR;
  2168.     IF(STATUS<>ERR)THEN BEGIN
  2169.       IF(I<=ISTART)THEN
  2170.         STATUS:=ENDDATA
  2171.       ELSE
  2172.         STATUS:=OK
  2173.     END;
  2174.     GETONE:=STATUS
  2175.   END;
  2176.   
  2177.         
  2178. FUNCTION GETLIST(VAR LIN:XSTRING;VAR I:INTEGER;
  2179.   VAR STATUS:STCODE):STCODE;
  2180. VAR
  2181.   NUM:INTEGER;
  2182.   DONE:BOOLEAN;
  2183. BEGIN
  2184.   LINE2:=0;
  2185.   NLINES:=0;
  2186.   DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK);
  2187.   WHILE(NOT DONE)DO BEGIN
  2188.     LINE1:=LINE2;
  2189.     LINE2:=NUM;
  2190.     NLINES:=NLINES+1;
  2191.     IF(LIN[I]=SEMICOL)THEN
  2192.       CURLN:=NUM;
  2193.     IF(LIN[I]=COMMA)OR(LIN[I]=SEMICOL)THEN BEGIN
  2194.       I:=I+1;
  2195.       DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK)
  2196.     END
  2197.     ELSE
  2198.       DONE:=TRUE
  2199.   END;
  2200.   NLINES:=MIN(NLINES,2);
  2201.   IF(NLINES=0)THEN
  2202.     LINE2:=CURLN;
  2203.   IF(NLINES<=1)THEN
  2204.     LINE1:=LINE2;
  2205.   IF(STATUS<>ERR)THEN
  2206.     STATUS:=OK;
  2207.   GETLIST:=STATUS
  2208. END;
  2209.  
  2210. PROCEDURE REVERSE(N1,N2:INTEGER);
  2211. VAR
  2212.   TEMP:BUFTYPE;
  2213. BEGIN
  2214.   WHILE(N1<N2)DO BEGIN
  2215.     TEMP:=BUF[N1];
  2216.     BUF[N1]:=BUF[N2];
  2217.     BUF[N2]:=TEMP;
  2218.     N1:=N1+1;
  2219.     N2:=N2-1
  2220.   END
  2221. END;
  2222. PROCEDURE BLKMOVE(N1,N2,N3:INTEGER);
  2223. BEGIN
  2224.   IF(N3<N1-1)THEN BEGIN
  2225.     REVERSE(N3+1,N1-1);
  2226.     REVERSE(N1,N2);
  2227.     REVERSE(N3+1,N2)
  2228.   END
  2229.   ELSE IF(N3>N2)THEN BEGIN
  2230.     REVERSE(N1,N2);
  2231.     REVERSE(N2+1,N3);
  2232.     REVERSE(N1,N3)
  2233.   END
  2234. END;
  2235.  
  2236. FUNCTION MOVE(LINE3:INTEGER):STCODE;
  2237. BEGIN
  2238.   IF(LINE1<=0)OR((LINE3>=LINE1)AND(LINE3<LINE2))THEN
  2239.     MOVE:=ERR
  2240.   ELSE BEGIN
  2241.     BLKMOVE(LINE1,LINE2,LINE3);
  2242.     IF(LINE3>LINE1)THEN
  2243.       CURLN:=LINE3
  2244.     ELSE
  2245.        CURLN:=LINE3+(LINE2-LINE1+1);
  2246.      MOVE:=OK
  2247.    END
  2248.  END;
  2249.  
  2250. FUNCTION LNDELETE(N1,N2:INTEGER;VAR STATUS:STCODE):
  2251. STCODE;
  2252. BEGIN
  2253.   IF(N1<=0)THEN
  2254.     STATUS:=ERR
  2255.   ELSE BEGIN
  2256.     BLKMOVE(N1,N2,LASTLN);
  2257.     LASTLN:=LASTLN-(N2-N1+1);
  2258.     CURLN:=PREVLN(N1);
  2259.     STATUS:=OK
  2260.   END;
  2261.   LNDELETE:=STATUS
  2262. END;
  2263.  
  2264. FUNCTION CKP(VAR LIN:XSTRING;I:INTEGER;
  2265.   VAR PFLAG:BOOLEAN;VAR STATUS:STCODE):STCODE;
  2266. BEGIN
  2267.   SKIPBL(LIN,I);
  2268.   IF(LIN[I]=PCMD)THEN BEGIN
  2269.     I:=I+1;
  2270.     PFLAG:=TRUE
  2271.   END
  2272.   ELSE
  2273.     PFLAG:=FALSE;
  2274.   IF(LIN[I]=NEWLINE)THEN
  2275.     STATUS:=OK
  2276.   ELSE
  2277.     STATUS:=ERR;
  2278.   CKP:=STATUS
  2279. END;
  2280.  
  2281. FUNCTION PUTTXT(VAR LIN:XSTRING):STCODE;
  2282. VAR I:INTEGER;
  2283. BEGIN
  2284.   PUTTXT:=ERR;
  2285.   IF(LASTLN<MAXLINES) THEN BEGIN
  2286.     i:=0;
  2287.     seek(editfid,recout);
  2288.     lastln:=lastln+1;
  2289.     buf[lastln].txt:=recout;
  2290.     repeat
  2291.       i:=succ(i);
  2292.       WRITE(EDITFID,lin[i]);
  2293.       recout:=recout+1
  2294.     until lin[i]=ENDSTR;
  2295.     write(editfid,lin[i]);
  2296.     PUTMARK(LASTLN,FALSE);
  2297.     BLKMOVE(LASTLN,LASTLN,CURLN);
  2298.     CURLN:=CURLN+1;
  2299.     PUTTXT:=OK
  2300.   END
  2301. END;
  2302.  
  2303. PROCEDURE SETBUF;
  2304. BEGIN
  2305. (*$I-*)
  2306.   ASSIGN(EDITFID,'EDTEMP');
  2307.   RESET(EDITFID);
  2308.   IF (IORESULT<>0) THEN REWRITE(EDITFID);
  2309. (*$I+*)
  2310.  
  2311.   RECOUT:=0;
  2312.   RECIN:=0;
  2313.   CURLN:=0;
  2314.   LASTLN:=0
  2315. END;
  2316.  
  2317.  
  2318. PROCEDURE CLRBUF;
  2319. BEGIN
  2320.   CLOSE(EDITFID);ERASE(EDITFID)
  2321. END;
  2322.  
  2323. FUNCTION APPEND(LINE:INTEGER;GLOB:BOOLEAN):STCODE;
  2324. VAR
  2325.   EINLINE:XSTRING;
  2326.   STAT:STCODE;
  2327.   DONE:BOOLEAN;
  2328. BEGIN
  2329.   IF(GLOB)THEN
  2330.     STAT:=ERR
  2331.   ELSE BEGIN
  2332.     CURLN:=LINE;
  2333.     STAT:=OK;
  2334.     DONE:=FALSE;
  2335.     WHILE(NOT DONE)AND(STAT=OK)DO
  2336.       IF(NOT GETLINE(EINLINE,STDIN,MAXSTR))THEN
  2337.         STAT:=ENDDATA
  2338.       ELSE IF(EINLINE[1]=PERIOD)
  2339.         AND(EINLINE[2]=NEWLINE)THEN
  2340.           DONE:=TRUE
  2341.       ELSE IF(PUTTXT(EINLINE)=ERR)THEN
  2342.         STAT:=ERR
  2343.   END;
  2344.   APPEND:=STAT
  2345. END;
  2346.  
  2347. FUNCTION DOWRITE(N1,N2:INTEGER;VAR FIL:XSTRING):STCODE;
  2348. VAR
  2349.   I:INTEGER;
  2350.   FD: FILEDESC;
  2351.   LINE: XSTRING;
  2352. BEGIN
  2353.   FD:=CREATE(FIL,IOWRITE);
  2354.   IF(FD=IOERROR)THEN
  2355.     DOWRITE:=ERR
  2356.   ELSE BEGIN
  2357.     FOR I:=N1 TO N2 DO BEGIN
  2358.       GETTXT(I,LINE);
  2359.       PUTSTR(LINE,FD)
  2360.     END;
  2361.     XCLOSE(FD);
  2362.     PUTDEC(N2-N1+1,1);
  2363.     PUTC(NEWLINE);
  2364.     DOWRITE:=OK
  2365.   END
  2366. END;
  2367.  
  2368. FUNCTION DOREAD(N:INTEGER;VAR FIL:XSTRING):STCODE;
  2369. VAR
  2370.   COUNT:INTEGER;
  2371.   T:BOOLEAN;
  2372.   STAT:STCODE;
  2373.   FD:FILEDESC;
  2374.   EINLINE:XSTRING;
  2375. BEGIN
  2376.   FD:=OPEN(FIL,IOREAD);
  2377.   IF(FD=IOERROR)THEN
  2378.     STAT:=ERR
  2379.   ELSE BEGIN
  2380.     CURLN:=N;
  2381.     STAT:=OK;
  2382.     COUNT:=0;
  2383.     REPEAT
  2384.       T:=GETLINE(EINLINE,FD,MAXSTR);
  2385.       IF(T)THEN BEGIN
  2386.         STAT:=PUTTXT(EINLINE);
  2387.         IF(STAT<>ERR)THEN
  2388.           COUNT:=COUNT+1
  2389.       END
  2390.     UNTIL(STAT<>OK)OR(T=FALSE);
  2391.     XCLOSE(FD);
  2392.     PUTDEC(COUNT,1);
  2393.     PUTC(NEWLINE)
  2394.   END;
  2395.   DOREAD:=STAT
  2396. END;
  2397.  
  2398. FUNCTION GETFN(VAR LIN:XSTRING;VAR I:INTEGER;
  2399.   VAR FIL:XSTRING):STCODE;
  2400. VAR
  2401.   K:INTEGER;
  2402.   STAT:STCODE;
  2403.  
  2404. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT:
  2405.   XSTRING):INTEGER;
  2406. VAR
  2407.   J:INTEGER;
  2408. BEGIN
  2409.   WHILE(S[I]IN [BLANK,TAB,NEWLINE])DO
  2410.     I:=I+1;
  2411.   J:=1;
  2412.   WHILE(NOT(S[I]IN [ENDSTR,BLANK,TAB,
  2413.     NEWLINE]))DO BEGIN
  2414.     OUT[J]:=S[I];
  2415.     I:=I+1;
  2416.     J:=J+1
  2417.   END;
  2418.   OUT[J]:=ENDSTR;
  2419.   IF(S[I]=ENDSTR)THEN
  2420.     GETWORD:=0
  2421.   ELSE
  2422.     GETWORD:=I
  2423. END;
  2424.  
  2425. BEGIN(*GETFN*)
  2426.   STAT:=ERR;
  2427.   IF(LIN[I+1]=BLANK)THEN BEGIN
  2428.     K:=GETWORD(LIN,I+2,FIL);
  2429.     IF(K>0)THEN
  2430.       IF(LIN[K]=NEWLINE)THEN
  2431.         STAT:=OK
  2432.   END
  2433.   ELSE IF(LIN[I+1]=NEWLINE)
  2434.     AND(SAVEFILE[1]<>ENDSTR)THEN BEGIN
  2435.       SCOPY(SAVEFILE,1,FIL,1);
  2436.       STAT:=OK;
  2437.   END;
  2438.   IF(STAT=OK)AND(SAVEFILE[1]=ENDSTR)THEN
  2439.     SCOPY(FIL,1,SAVEFILE,1);
  2440.   GETFN:=STAT
  2441. END;
  2442.  
  2443. PROCEDURE CATSUB(VAR LIN:XSTRING;S1,S2: INTEGER;
  2444.   VAR SUB: XSTRING;VAR NEW:XSTRING;
  2445.   VAR K:INTEGER;MAXNEW:INTEGER);
  2446. VAR
  2447.   I,J:INTEGER;
  2448.   JUNK:BOOLEAN;
  2449. BEGIN
  2450.   I:=1;
  2451.   WHILE(SUB[I]<>ENDSTR)DO BEGIN
  2452.     IF(SUB[I]=DITTO)THEN
  2453.       FOR J:=S1 TO S2-1 DO
  2454.         JUNK:=ADDSTR(LIN[J],NEW,K,MAXNEW)
  2455.       ELSE
  2456.         JUNK:=ADDSTR(SUB[I],NEW,K,MAXNEW);
  2457.       I:=I+1
  2458.   END
  2459. END;
  2460.  
  2461. FUNCTION SUBST( VAR SUB:XSTRING;GFLAG,GLOB:BOOLEAN):STCODE;
  2462. VAR
  2463.   NEW,OLD:XSTRING;
  2464.   J,K,LASTM,LINE,M:INTEGER;
  2465.   STAT:STCODE;
  2466.   DONE,SUBBED,JUNK:BOOLEAN;
  2467. BEGIN
  2468.   IF(GLOB)THEN
  2469.     STAT:=OK
  2470.   ELSE
  2471.     STAT:=ERR;
  2472.     DONE:=(LINE1<=0);
  2473.     LINE:=LINE1;
  2474.     WHILE(NOT DONE)AND(LINE<=LINE2)DO BEGIN
  2475.       J:=1;
  2476.       SUBBED:=FALSE;
  2477.       GETTXT(LINE,OLD);
  2478.       LASTM:=0;
  2479.       K:=1;
  2480.       WHILE(OLD[K]<>ENDSTR)DO BEGIN
  2481.         IF(GFLAG)OR(NOT SUBBED)THEN
  2482.           M:=AMATCH(OLD,K,PAT,1)
  2483.         ELSE
  2484.           M:=0;
  2485.         IF(M>0)AND(LASTM<>M)THEN BEGIN
  2486.           SUBBED:=TRUE;
  2487.           CATSUB(OLD,K,M,SUB,NEW,J,MAXSTR);
  2488.           LASTM:=M
  2489.         END;
  2490.         IF(M=0)OR(M=K)THEN BEGIN
  2491.           JUNK:=ADDSTR(OLD[K],NEW,J,MAXSTR);
  2492.           K:=K+1
  2493.         END
  2494.         ELSE
  2495.           K:=M
  2496.       END;
  2497.       IF(SUBBED)THEN BEGIN
  2498.         IF(NOT ADDSTR(ENDSTR,NEW,J,MAXSTR))THEN BEGIN
  2499.           STAT:=ERR;
  2500.           DONE:=TRUE
  2501.         END
  2502.         ELSE BEGIN
  2503.           STAT:=LNDELETE(LINE,LINE,STATUS);
  2504.           STAT:=PUTTXT(NEW);
  2505.           LINE2:=LINE2+CURLN-LINE;
  2506.           LINE:=CURLN;
  2507.           IF(STAT=ERR)THEN
  2508.             DONE:=TRUE
  2509.           ELSE
  2510.             STAT:=OK
  2511.           END
  2512.         END;
  2513.         LINE:=LINE+1
  2514.       END;
  2515.       SUBST:=STAT
  2516.     END;
  2517. FUNCTION MAKESUB(VAR ARG:XSTRING;FROM:INTEGER;
  2518.   DELIM:CHARACTER;VAR SUB:XSTRING):INTEGER;
  2519. VAR I,J:INTEGER;
  2520.    JUNK:BOOLEAN;
  2521. BEGIN
  2522.   J:=1;
  2523.   I:=FROM;
  2524.   WHILE(ARG[I]<>DELIM)AND(ARG[I]<>ENDSTR)DO BEGIN
  2525.     IF(ARG[I]=ORD('&'))THEN
  2526.       JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
  2527.     ELSE
  2528.       JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
  2529.     I:=I+1
  2530.   END;
  2531.   IF(ARG[I]<>DELIM) THEN
  2532.     MAKESUB:=0
  2533.   ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT))THEN
  2534.     MAKESUB:=0
  2535.   ELSE
  2536.     MAKESUB:=I
  2537. END;
  2538. FUNCTION GETRHS(VAR LIN:XSTRING;VAR I:INTEGER;
  2539.   VAR SUB:XSTRING;VAR GFLAG:BOOLEAN):STCODE;
  2540. BEGIN
  2541.   GETRHS:=OK;
  2542.   IF(LIN[I]=ENDSTR)THEN
  2543.     GETRHS:=ERR
  2544.   ELSE IF(LIN[I+1]=ENDSTR)THEN
  2545.     GETRHS:=ERR
  2546.   ELSE BEGIN
  2547.     I:=MAKESUB(LIN,I+1,LIN[I],SUB);
  2548.     IF(I=0)THEN
  2549.       GETRHS:=ERR
  2550.     ELSE IF(LIN[I+1]=ORD('G'))THEN BEGIN
  2551.       I:=I+1;
  2552.       GFLAG:=TRUE
  2553.     END
  2554.     ELSE
  2555.       GFLAG:=FALSE
  2556.   END
  2557. END;
  2558.  
  2559. FUNCTION DOCMD(VAR LIN:XSTRING;VAR I:INTEGER;
  2560.   GLOB:BOOLEAN;VAR STATUS:STCODE):STCODE;
  2561. VAR
  2562.   FIL,SUB:XSTRING;
  2563.   LINE3:INTEGER;
  2564.   GFLAG,PFLAG:BOOLEAN;
  2565. BEGIN
  2566.   PFLAG:=FALSE;
  2567.   STATUS:=ERR;
  2568.   IF(LIN[I]=PCMD)THEN BEGIN
  2569.     IF(LIN[I+1]=NEWLINE)THEN 
  2570.       IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
  2571.         STATUS:=DOPRINT(LINE1,LINE2)
  2572.   END
  2573.   ELSE IF(LIN[I]=NEWLINE)THEN BEGIN
  2574.     IF(NLINES=0)THEN
  2575.       LINE2:=NEXTLN(CURLN);
  2576.     STATUS:=DOPRINT(LINE2,LINE2)
  2577.   END
  2578.   ELSE IF(LIN[I]=QCMD)THEN BEGIN
  2579.     IF( LIN[I+1]=NEWLINE)AND(NLINES=0)AND(NOT GLOB)THEN
  2580.   STATUS:=ENDDATA
  2581.   END
  2582.   ELSE IF(LIN[I]=ACMD)THEN BEGIN
  2583.     IF(LIN[I+1]=NEWLINE)THEN
  2584.       STATUS:=APPEND(LINE2,GLOB)
  2585.   END
  2586.   ELSE IF(LIN[I]=CCMD)THEN BEGIN
  2587.     IF(LIN[I+1]=NEWLINE)THEN
  2588.       IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
  2589.       IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN
  2590.         STATUS:=APPEND(PREVLN(LINE1),GLOB)
  2591.   END
  2592.   ELSE IF(LIN[I]=DCMD)THEN BEGIN
  2593.     IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN
  2594.      IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
  2595.      IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN
  2596.      IF(NEXTLN(CURLN)<>0)THEN
  2597.        CURLN:=NEXTLN(CURLN)
  2598.   END
  2599.   ELSE IF(LIN[I]=ICMD)THEN BEGIN
  2600.     IF(LIN[I+1]=NEWLINE)THEN BEGIN
  2601.       IF(LINE2=0)THEN
  2602.         STATUS:=APPEND(0,GLOB)
  2603.       ELSE
  2604.         STATUS:=APPEND(PREVLN(LINE2),GLOB)
  2605.     END
  2606.   END
  2607.   ELSE IF(LIN[I]=EQCMD)THEN BEGIN
  2608.     IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN BEGIN
  2609.       PUTDEC(LINE2,1);
  2610.       PUTC(NEWLINE)
  2611.     END
  2612.   END
  2613.   ELSE IF(LIN[I]=MCMD)THEN BEGIN
  2614.     I:=I+1;
  2615.     IF(GETONE(LIN,I,LINE3,STATUS)=ENDDATA)THEN
  2616.       STATUS:=ERR;
  2617.     IF(STATUS =OK)THEN
  2618.       IF(CKP(LIN,I,PFLAG,STATUS)=OK)THEN
  2619.       IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
  2620.         STATUS:=MOVE(LINE3)
  2621.   END
  2622.   ELSE IF(LIN[I]=SCMD)THEN BEGIN
  2623.     I:=I+1;
  2624.     IF(OPTPAT(LIN,I)=OK)THEN 
  2625.     IF(GETRHS(LIN,I,SUB,GFLAG)=OK)THEN
  2626.     IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN
  2627.     IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
  2628.       STATUS:=SUBST(SUB,GFLAG,GLOB)
  2629.   END
  2630.   ELSE IF(LIN[I]=ECMD)THEN BEGIN
  2631.     IF(NLINES =0)THEN
  2632.       IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN
  2633.         SCOPY(FIL,1,SAVEFILE,1);
  2634.         CLRBUF;
  2635.         SETBUF;
  2636.         STATUS:=DOREAD(0,FIL)
  2637.       END
  2638.   END
  2639.   ELSE IF(LIN[I]=FCMD)THEN BEGIN
  2640.     IF(NLINES =0)THEN
  2641.       IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN
  2642.         SCOPY(FIL,1,SAVEFILE,1);
  2643.         PUTSTR(SAVEFILE,STDOUT);
  2644.         PUTC(NEWLINE);
  2645.         STATUS:=OK
  2646.     END
  2647.   END
  2648.   ELSE IF(LIN[I]=RCMD)THEN BEGIN
  2649.     IF(GETFN(LIN,I,FIL)=OK)THEN
  2650.       STATUS:=DOREAD(LINE2,FIL)
  2651.   END
  2652.   ELSE IF(LIN[I]=WCMD)THEN BEGIN
  2653.     IF(GETFN(LIN,I,FIL)=OK)THEN
  2654.       IF(DEFAULT(1,LASTLN,STATUS)=OK)THEN
  2655.         STATUS:=DOWRITE(LINE1,LINE2,FIL)
  2656.   END;
  2657.   IF(STATUS =OK)AND(PFLAG)THEN
  2658.     STATUS:=DOPRINT(CURLN,CURLN);
  2659.   DOCMD:=STATUS
  2660. END;(*DOCMD*)
  2661.  
  2662. FUNCTION CKGLOB(VAR LIN: XSTRING;VAR I:INTEGER;
  2663.   VAR STATUS:STCODE): STCODE;
  2664. VAR
  2665.   N:INTEGER;
  2666.   GFLAG:BOOLEAN;
  2667.   TEMP: XSTRING;
  2668. BEGIN
  2669.   IF(LIN[I]<>GCMD)AND(LIN[I]<>XCMD)THEN
  2670.     STATUS:=ENDDATA
  2671.   ELSE BEGIN
  2672.     GFLAG:=(LIN[I]=GCMD);
  2673.     I:=I+1;
  2674.     IF(OPTPAT(LIN,I)=ERR)THEN
  2675.       STATUS:=ERR
  2676.     ELSE IF( DEFAULT(1,LASTLN,STATUS)<>ERR)THEN BEGIN
  2677.       I:=I+1;
  2678.       FOR N:=LINE1 TO LINE2 DO BEGIN
  2679.         GETTXT(N,TEMP);
  2680.         PUTMARK(N,(MATCH(TEMP,PAT)=GFLAG))
  2681.       END;
  2682.  
  2683.       FOR N:=1 TO LINE1-1 DO
  2684.         PUTMARK(N,FALSE);
  2685.       FOR N:=LINE2+1 TO LASTLN DO
  2686.         PUTMARK(N,FALSE);
  2687.       STATUS:=OK
  2688.     END
  2689.   END;
  2690.   CKGLOB:=STATUS
  2691. END;
  2692.  
  2693. FUNCTION DOGLOB(VAR LIN:XSTRING;VAR I,CURSAVE:INTEGER;
  2694.   VAR STATUS: STCODE):STCODE;
  2695. VAR
  2696.   COUNT,ISTART,N: INTEGER;
  2697. BEGIN
  2698.   STATUS:=OK;
  2699.   COUNT:=0;
  2700.   N:=LINE1;
  2701.   ISTART:=I;
  2702.   REPEAT
  2703.     IF(GETMARK(N))THEN BEGIN
  2704.       PUTMARK(N,FALSE);
  2705.       CURLN:=N;
  2706.       CURSAVE:=CURLN;
  2707.       I:=ISTART;
  2708.       IF(DOCMD(LIN,I,TRUE,STATUS)=OK)THEN
  2709.         COUNT:=0
  2710.     END
  2711.     ELSE BEGIN
  2712.       N:=NEXTLN(N);
  2713.       COUNT:=COUNT + 1
  2714.     END
  2715.   UNTIL(COUNT > LASTLN)OR(STATUS <> OK);
  2716.   DOGLOB:=STATUS
  2717. END;
  2718.  
  2719. BEGIN
  2720.   SETBUF;
  2721.   PAT[1]:=ENDSTR;
  2722.   SAVEFILE[1]:=ENDSTR;
  2723.   IF(GETARG(2,SAVEFILE,MAXSTR))THEN
  2724.     IF(DOREAD(0,SAVEFILE)=ERR)THEN
  2725.       WRITELN('?');
  2726.   MORE:=GETLINE(LIN,STDIN,MAXSTR);
  2727.   WHILE(MORE)DO BEGIN
  2728.     I:=1;
  2729.     CURSAVE:=CURLN;
  2730.     IF(GETLIST(LIN,I,STATUS)=OK)THEN BEGIN
  2731.       IF(CKGLOB(LIN,I,STATUS)=OK)THEN
  2732.         STATUS:=DOGLOB(LIN,I,CURSAVE,STATUS)
  2733.       ELSE IF(STATUS<>ERR)THEN
  2734.         STATUS:=DOCMD(LIN,I,FALSE,STATUS)
  2735.     END;
  2736.     IF(STATUS=ERR)THEN BEGIN
  2737.       WRITELN('?');
  2738.       CURLN:=MIN(CURSAVE,LASTLN)
  2739.     END
  2740.     ELSE IF(STATUS=ENDDATA)THEN
  2741.       MORE:=FALSE;
  2742.     IF(MORE)THEN
  2743.       MORE:=GETLINE(LIN,STDIN,MAXSTR)
  2744.   END;
  2745.   CLRBUF
  2746. END;
  2747.  
  2748.  
  2749.  
  2750.  
  2751. SHAR_EOF
  2752. if test 16451 -ne "`wc -c < 'chapter6.pas'`"
  2753. then
  2754.     echo shar: error transmitting "'chapter6.pas'" '(should have been 16451 characters)'
  2755. fi
  2756. fi # end of overwriting check
  2757. #    End of shell archive
  2758. exit 0
  2759.